home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / generic / tclIO.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  182.1 KB  |  5,964 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclIO.c --
  3.  *
  4.  *    This file provides the generic portions (those that are the same on
  5.  *    all platforms and for all channel types) of Tcl's IO facilities.
  6.  *
  7.  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tclIO.c 1.268 97/07/28 14:20:36
  13.  */
  14.  
  15. #include    "tclInt.h"
  16. #include    "tclPort.h"
  17.  
  18. /*
  19.  * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
  20.  * compile on systems where neither is defined. We want both defined so
  21.  * that we can test safely for both. In the code we still have to test for
  22.  * both because there may be systems on which both are defined and have
  23.  * different values.
  24.  */
  25.  
  26. #if ((!defined(EWOULDBLOCK)) && (defined(EAGAIN)))
  27. #   define EWOULDBLOCK EAGAIN
  28. #endif
  29. #if ((!defined(EAGAIN)) && (defined(EWOULDBLOCK)))
  30. #   define EAGAIN EWOULDBLOCK
  31. #endif
  32. #if ((!defined(EAGAIN)) && (!defined(EWOULDBLOCK)))
  33.     error one of EWOULDBLOCK or EAGAIN must be defined
  34. #endif
  35.  
  36. /*
  37.  * The following structure encapsulates the state for a background channel
  38.  * copy.  Note that the data buffer for the copy will be appended to this
  39.  * structure.
  40.  */
  41.  
  42. typedef struct CopyState {
  43.     struct Channel *readPtr;    /* Pointer to input channel. */
  44.     struct Channel *writePtr;    /* Pointer to output channel. */
  45.     int readFlags;        /* Original read channel flags. */
  46.     int writeFlags;        /* Original write channel flags. */
  47.     int toRead;            /* Number of bytes to copy, or -1. */
  48.     int total;            /* Total bytes transferred (written). */
  49.     Tcl_Interp *interp;        /* Interp that started the copy. */
  50.     Tcl_Obj *cmdPtr;        /* Command to be invoked at completion. */
  51.     int bufSize;        /* Size of appended buffer. */
  52.     char buffer[1];        /* Copy buffer, this must be the last
  53.                  * field. */
  54. } CopyState;
  55.  
  56. /*
  57.  * struct ChannelBuffer:
  58.  *
  59.  * Buffers data being sent to or from a channel.
  60.  */
  61.  
  62. typedef struct ChannelBuffer {
  63.     int nextAdded;        /* The next position into which a character
  64.                                  * will be put in the buffer. */
  65.     int nextRemoved;        /* Position of next byte to be removed
  66.                                  * from the buffer. */
  67.     int bufSize;        /* How big is the buffer? */
  68.     struct ChannelBuffer *nextPtr;
  69.                     /* Next buffer in chain. */
  70.     char buf[4];        /* Placeholder for real buffer. The real
  71.                                  * buffer occuppies this space + bufSize-4
  72.                                  * bytes. This must be the last field in
  73.                                  * the structure. */
  74. } ChannelBuffer;
  75.  
  76. #define CHANNELBUFFER_HEADER_SIZE    (sizeof(ChannelBuffer) - 4)
  77.  
  78. /*
  79.  * The following defines the *default* buffer size for channels.
  80.  */
  81.  
  82. #define CHANNELBUFFER_DEFAULT_SIZE    (1024 * 4)
  83.  
  84. /*
  85.  * Structure to record a close callback. One such record exists for
  86.  * each close callback registered for a channel.
  87.  */
  88.  
  89. typedef struct CloseCallback {
  90.     Tcl_CloseProc *proc;        /* The procedure to call. */
  91.     ClientData clientData;        /* Arbitrary one-word data to pass
  92.                                          * to the callback. */
  93.     struct CloseCallback *nextPtr;    /* For chaining close callbacks. */
  94. } CloseCallback;
  95.  
  96. /*
  97.  * The following structure describes the information saved from a call to
  98.  * "fileevent". This is used later when the event being waited for to
  99.  * invoke the saved script in the interpreter designed in this record.
  100.  */
  101.  
  102. typedef struct EventScriptRecord {
  103.     struct Channel *chanPtr;    /* The channel for which this script is
  104.                                  * registered. This is used only when an
  105.                                  * error occurs during evaluation of the
  106.                                  * script, to delete the handler. */
  107.     char *script;        /* Script to invoke. */
  108.     Tcl_Interp *interp;        /* In what interpreter to invoke script? */
  109.     int mask;            /* Events must overlap current mask for the
  110.                                  * stored script to be invoked. */
  111.     struct EventScriptRecord *nextPtr;
  112.                     /* Next in chain of records. */
  113. } EventScriptRecord;
  114.  
  115. /*
  116.  * struct Channel:
  117.  *
  118.  * One of these structures is allocated for each open channel. It contains data
  119.  * specific to the channel but which belongs to the generic part of the Tcl
  120.  * channel mechanism, and it points at an instance specific (and type
  121.  * specific) * instance data, and at a channel type structure.
  122.  */
  123.  
  124. typedef struct Channel {
  125.     char *channelName;        /* The name of the channel instance in Tcl
  126.                                  * commands. Storage is owned by the generic IO
  127.                                  * code,  is dynamically allocated. */
  128.     int    flags;            /* ORed combination of the flags defined
  129.                                  * below. */
  130.     Tcl_EolTranslation inputTranslation;
  131.                 /* What translation to apply for end of line
  132.                                  * sequences on input? */    
  133.     Tcl_EolTranslation outputTranslation;
  134.                     /* What translation to use for generating
  135.                                  * end of line sequences in output? */
  136.     int inEofChar;        /* If nonzero, use this as a signal of EOF
  137.                                  * on input. */
  138.     int outEofChar;             /* If nonzero, append this to the channel
  139.                                  * when it is closed if it is open for
  140.                                  * writing. */
  141.     int unreportedError;    /* Non-zero if an error report was deferred
  142.                                  * because it happened in the background. The
  143.                                  * value is the POSIX error code. */
  144.     ClientData instanceData;    /* Instance specific data. */
  145.     Tcl_ChannelType *typePtr;    /* Pointer to channel type structure. */
  146.     int refCount;        /* How many interpreters hold references to
  147.                                  * this IO channel? */
  148.     CloseCallback *closeCbPtr;    /* Callbacks registered to be called when the
  149.                                  * channel is closed. */
  150.     ChannelBuffer *curOutPtr;    /* Current output buffer being filled. */
  151.     ChannelBuffer *outQueueHead;/* Points at first buffer in output queue. */
  152.     ChannelBuffer *outQueueTail;/* Points at last buffer in output queue. */
  153.  
  154.     ChannelBuffer *saveInBufPtr;/* Buffer saved for input queue - eliminates
  155.                                  * need to allocate a new buffer for "gets"
  156.                                  * that crosses buffer boundaries. */
  157.     ChannelBuffer *inQueueHead;    /* Points at first buffer in input queue. */
  158.     ChannelBuffer *inQueueTail;    /* Points at last buffer in input queue. */
  159.  
  160.     struct ChannelHandler *chPtr;/* List of channel handlers registered
  161.                                   * for this channel. */
  162.     int interestMask;        /* Mask of all events this channel has
  163.                                  * handlers for. */
  164.     struct Channel *nextChanPtr;/* Next in list of channels currently open. */
  165.     EventScriptRecord *scriptRecordPtr;
  166.                     /* Chain of all scripts registered for
  167.                                  * event handlers ("fileevent") on this
  168.                                  * channel. */
  169.     int bufSize;        /* What size buffers to allocate? */
  170.     Tcl_TimerToken timer;    /* Handle to wakeup timer for this channel. */
  171.     CopyState *csPtr;        /* State of background copy, or NULL. */
  172. } Channel;
  173.     
  174. /*
  175.  * Values for the flags field in Channel. Any ORed combination of the
  176.  * following flags can be stored in the field. These flags record various
  177.  * options and state bits about the channel. In addition to the flags below,
  178.  * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
  179.  */
  180.  
  181. #define CHANNEL_NONBLOCKING    (1<<3)    /* Channel is currently in
  182.                      * nonblocking mode. */
  183. #define CHANNEL_LINEBUFFERED    (1<<4)    /* Output to the channel must be
  184.                      * flushed after every newline. */
  185. #define CHANNEL_UNBUFFERED    (1<<5)    /* Output to the channel must always
  186.                      * be flushed immediately. */
  187. #define BUFFER_READY        (1<<6)    /* Current output buffer (the
  188.                      * curOutPtr field in the
  189.                                          * channel structure) should be
  190.                                          * output as soon as possible even
  191.                                          * though it may not be full. */
  192. #define BG_FLUSH_SCHEDULED    (1<<7)    /* A background flush of the
  193.                      * queued output buffers has been
  194.                                          * scheduled. */
  195. #define CHANNEL_CLOSED        (1<<8)    /* Channel has been closed. No
  196.                      * further Tcl-level IO on the
  197.                                          * channel is allowed. */
  198. #define CHANNEL_EOF        (1<<9)    /* EOF occurred on this channel.
  199.                      * This bit is cleared before every
  200.                                          * input operation. */
  201. #define CHANNEL_STICKY_EOF    (1<<10)    /* EOF occurred on this channel because
  202.                      * we saw the input eofChar. This bit
  203.                                          * prevents clearing of the EOF bit
  204.                                          * before every input operation. */
  205. #define CHANNEL_BLOCKED    (1<<11)    /* EWOULDBLOCK or EAGAIN occurred
  206.                      * on this channel. This bit is
  207.                                          * cleared before every input or
  208.                                          * output operation. */
  209. #define INPUT_SAW_CR        (1<<12)    /* Channel is in CRLF eol input
  210.                      * translation mode and the last
  211.                                          * byte seen was a "\r". */
  212. #define CHANNEL_DEAD        (1<<13)    /* The channel has been closed by
  213.                      * the exit handler (on exit) but
  214.                                          * not deallocated. When any IO
  215.                                          * operation sees this flag on a
  216.                                          * channel, it does not call driver
  217.                                          * level functions to avoid referring
  218.                                          * to deallocated data. */
  219. #define CHANNEL_GETS_BLOCKED    (1<<14)    /* The last input operation was a gets
  220.                      * that failed to get a comlete line.
  221.                      * When set, file events will not be
  222.                      * delivered for buffered data unless
  223.                      * an EOL is present. */
  224.  
  225. /*
  226.  * For each channel handler registered in a call to Tcl_CreateChannelHandler,
  227.  * there is one record of the following type. All of records for a specific
  228.  * channel are chained together in a singly linked list which is stored in
  229.  * the channel structure.
  230.  */
  231.  
  232. typedef struct ChannelHandler {
  233.     Channel *chanPtr;        /* The channel structure for this channel. */
  234.     int mask;            /* Mask of desired events. */
  235.     Tcl_ChannelProc *proc;    /* Procedure to call in the type of
  236.                                  * Tcl_CreateChannelHandler. */
  237.     ClientData clientData;    /* Argument to pass to procedure. */
  238.     struct ChannelHandler *nextPtr;
  239.                     /* Next one in list of registered handlers. */
  240. } ChannelHandler;
  241.  
  242. /*
  243.  * This structure keeps track of the current ChannelHandler being invoked in
  244.  * the current invocation of ChannelHandlerEventProc. There is a potential
  245.  * problem if a ChannelHandler is deleted while it is the current one, since
  246.  * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
  247.  * problem, structures of the type below indicate the next handler to be
  248.  * processed for any (recursively nested) dispatches in progress. The
  249.  * nextHandlerPtr field is updated if the handler being pointed to is deleted.
  250.  * The nextPtr field is used to chain together all recursive invocations, so
  251.  * that Tcl_DeleteChannelHandler can find all the recursively nested
  252.  * invocations of ChannelHandlerEventProc and compare the handler being
  253.  * deleted against the NEXT handler to be invoked in that invocation; when it
  254.  * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
  255.  * field of the structure to the next handler.
  256.  */
  257.  
  258. typedef struct NextChannelHandler {
  259.     ChannelHandler *nextHandlerPtr;    /* The next handler to be invoked in
  260.                                          * this invocation. */
  261.     struct NextChannelHandler *nestedHandlerPtr;
  262.                     /* Next nested invocation of
  263.                                          * ChannelHandlerEventProc. */
  264. } NextChannelHandler;
  265.  
  266. /*
  267.  * This variable holds the list of nested ChannelHandlerEventProc invocations.
  268.  */
  269.  
  270. static NextChannelHandler *nestedHandlerPtr = (NextChannelHandler *) NULL;
  271.  
  272. /*
  273.  * List of all channels currently open.
  274.  */
  275.  
  276. static Channel *firstChanPtr = (Channel *) NULL;
  277.  
  278. /*
  279.  * Has a channel exit handler been created yet?
  280.  */
  281.  
  282. static int channelExitHandlerCreated = 0;
  283.  
  284. /*
  285.  * The following structure describes the event that is added to the Tcl
  286.  * event queue by the channel handler check procedure.
  287.  */
  288.  
  289. typedef struct ChannelHandlerEvent {
  290.     Tcl_Event header;        /* Standard header for all events. */
  291.     Channel *chanPtr;        /* The channel that is ready. */
  292.     int readyMask;        /* Events that have occurred. */
  293. } ChannelHandlerEvent;
  294.  
  295. /*
  296.  * Static variables to hold channels for stdin, stdout and stderr.
  297.  */
  298.  
  299. static Tcl_Channel stdinChannel = NULL;
  300. static int stdinInitialized = 0;
  301. static Tcl_Channel stdoutChannel = NULL;
  302. static int stdoutInitialized = 0;
  303. static Tcl_Channel stderrChannel = NULL;
  304. static int stderrInitialized = 0;
  305.  
  306. /*
  307.  * Static functions in this file:
  308.  */
  309.  
  310. static void        ChannelEventScriptInvoker _ANSI_ARGS_((
  311.                 ClientData clientData, int flags));
  312. static void        ChannelTimerProc _ANSI_ARGS_((
  313.                 ClientData clientData));
  314. static void        CheckForStdChannelsBeingClosed _ANSI_ARGS_((
  315.                 Tcl_Channel chan));
  316. static void        CleanupChannelHandlers _ANSI_ARGS_((
  317.                 Tcl_Interp *interp, Channel *chanPtr));
  318. static int        CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
  319.                             Channel *chanPtr, int errorCode));
  320. static void        CloseChannelsOnExit _ANSI_ARGS_((ClientData data));
  321. static int        CopyAndTranslateBuffer _ANSI_ARGS_((
  322.                 Channel *chanPtr, char *result, int space));
  323. static int        CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
  324. static void        CopyEventProc _ANSI_ARGS_((ClientData clientData,
  325.                 int mask));
  326. static void        CreateScriptRecord _ANSI_ARGS_((
  327.                 Tcl_Interp *interp, Channel *chanPtr,
  328.                             int mask, char *script));
  329. static void        DeleteChannelTable _ANSI_ARGS_((
  330.                 ClientData clientData, Tcl_Interp *interp));
  331. static void        DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
  332.                     Channel *chanPtr, int mask));
  333. static void        DiscardInputQueued _ANSI_ARGS_((
  334.                 Channel *chanPtr, int discardSavedBuffers));
  335. static void        DiscardOutputQueued _ANSI_ARGS_((
  336.                     Channel *chanPtr));
  337. static int        DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
  338.                 int slen));
  339. static int        DoWrite _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
  340.                 int slen));
  341. static int        FlushChannel _ANSI_ARGS_((Tcl_Interp *interp,
  342.                             Channel *chanPtr, int calledFromAsyncFlush));
  343. static Tcl_HashTable    *GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
  344. static int        GetEOL _ANSI_ARGS_((Channel *chanPtr));
  345. static int        GetInput _ANSI_ARGS_((Channel *chanPtr));
  346. static void        RecycleBuffer _ANSI_ARGS_((Channel *chanPtr,
  347.                     ChannelBuffer *bufPtr, int mustDiscard));
  348. static int        ScanBufferForEOL _ANSI_ARGS_((Channel *chanPtr,
  349.                             ChannelBuffer *bufPtr,
  350.                             Tcl_EolTranslation translation, int eofChar,
  351.                     int *bytesToEOLPtr, int *crSeenPtr));
  352. static int        ScanInputForEOL _ANSI_ARGS_((Channel *chanPtr,
  353.                     int *bytesQueuedPtr));
  354. static int        SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
  355.                     Channel *chanPtr, int mode));
  356. static void        StopCopy _ANSI_ARGS_((CopyState *csPtr));
  357. static void        UpdateInterest _ANSI_ARGS_((Channel *chanPtr));
  358. static int        CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
  359.                             Channel *chan));
  360.  
  361. /*
  362.  *----------------------------------------------------------------------
  363.  *
  364.  * SetBlockMode --
  365.  *
  366.  *    This function sets the blocking mode for a channel and updates
  367.  *    the state flags.
  368.  *
  369.  * Results:
  370.  *    A standard Tcl result.
  371.  *
  372.  * Side effects:
  373.  *    Modifies the blocking mode of the channel and possibly generates
  374.  *    an error.
  375.  *
  376.  *----------------------------------------------------------------------
  377.  */
  378.  
  379. static int
  380. SetBlockMode(interp, chanPtr, mode)
  381.     Tcl_Interp *interp;        /* Interp for error reporting. */
  382.     Channel *chanPtr;        /* Channel to modify. */
  383.     int mode;            /* One of TCL_MODE_BLOCKING or
  384.                  * TCL_MODE_NONBLOCKING. */
  385. {
  386.     int result = 0;
  387.     if (chanPtr->typePtr->blockModeProc != NULL) {
  388.     result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
  389.         mode);
  390.     }
  391.     if (result != 0) {
  392.     Tcl_SetErrno(result);
  393.     if (interp != (Tcl_Interp *) NULL) {
  394.         Tcl_AppendResult(interp, "error setting blocking mode: ",
  395.             Tcl_PosixError(interp), (char *) NULL);
  396.     }
  397.     return TCL_ERROR;
  398.     }
  399.     if (mode == TCL_MODE_BLOCKING) {
  400.     chanPtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
  401.     } else {
  402.     chanPtr->flags |= CHANNEL_NONBLOCKING;
  403.     }
  404.     return TCL_OK;
  405. }
  406.  
  407. /*
  408.  *----------------------------------------------------------------------
  409.  *
  410.  * Tcl_SetStdChannel --
  411.  *
  412.  *    This function is used to change the channels that are used
  413.  *    for stdin/stdout/stderr in new interpreters.
  414.  *
  415.  * Results:
  416.  *    None
  417.  *
  418.  * Side effects:
  419.  *    None.
  420.  *
  421.  *----------------------------------------------------------------------
  422.  */
  423.  
  424. void
  425. Tcl_SetStdChannel(channel, type)
  426.     Tcl_Channel channel;
  427.     int type;            /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
  428. {
  429.     switch (type) {
  430.     case TCL_STDIN:
  431.             stdinInitialized = 1;
  432.         stdinChannel = channel;
  433.         break;
  434.     case TCL_STDOUT:
  435.         stdoutInitialized = 1;
  436.         stdoutChannel = channel;
  437.         break;
  438.     case TCL_STDERR:
  439.         stderrInitialized = 1;
  440.         stderrChannel = channel;
  441.         break;
  442.     }
  443. }
  444.  
  445. /*
  446.  *----------------------------------------------------------------------
  447.  *
  448.  * Tcl_GetStdChannel --
  449.  *
  450.  *    Returns the specified standard channel.
  451.  *
  452.  * Results:
  453.  *    Returns the specified standard channel, or NULL.
  454.  *
  455.  * Side effects:
  456.  *    May cause the creation of a standard channel and the underlying
  457.  *    file.
  458.  *
  459.  *----------------------------------------------------------------------
  460.  */
  461.  
  462. Tcl_Channel
  463. Tcl_GetStdChannel(type)
  464.     int type;            /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
  465. {
  466.     Tcl_Channel channel = NULL;
  467.  
  468.     /*
  469.      * If the channels were not created yet, create them now and
  470.      * store them in the static variables.  Note that we need to set
  471.      * stdinInitialized before calling TclGetDefaultStdChannel in order
  472.      * to avoid recursive loops when TclGetDefaultStdChannel calls
  473.      * Tcl_CreateChannel.
  474.      */
  475.  
  476.     switch (type) {
  477.     case TCL_STDIN:
  478.         if (!stdinInitialized) {
  479.         stdinChannel = TclGetDefaultStdChannel(TCL_STDIN);
  480.         stdinInitialized = 1;
  481.  
  482.                 /*
  483.                  * Artificially bump the refcount to ensure that the channel
  484.                  * is only closed on exit.
  485.                  *
  486.                  * NOTE: Must only do this if stdinChannel is not NULL. It
  487.                  * can be NULL in situations where Tcl is unable to connect
  488.                  * to the standard input.
  489.                  */
  490.  
  491.                 if (stdinChannel != (Tcl_Channel) NULL) {
  492.                     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
  493.                             stdinChannel);
  494.                 }
  495.         }
  496.         channel = stdinChannel;
  497.         break;
  498.     case TCL_STDOUT:
  499.         if (!stdoutInitialized) {
  500.         stdoutChannel = TclGetDefaultStdChannel(TCL_STDOUT);
  501.         stdoutInitialized = 1;
  502.  
  503.                 /*
  504.                  * Artificially bump the refcount to ensure that the channel
  505.                  * is only closed on exit.
  506.                  *
  507.                  * NOTE: Must only do this if stdoutChannel is not NULL. It
  508.                  * can be NULL in situations where Tcl is unable to connect
  509.                  * to the standard output.
  510.                  */
  511.  
  512.                 if (stdoutChannel != (Tcl_Channel) NULL) {
  513.                     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
  514.                             stdoutChannel);
  515.                 }
  516.         }
  517.         channel = stdoutChannel;
  518.         break;
  519.     case TCL_STDERR:
  520.         if (!stderrInitialized) {
  521.         stderrChannel = TclGetDefaultStdChannel(TCL_STDERR);
  522.         stderrInitialized = 1;
  523.  
  524.                 /*
  525.                  * Artificially bump the refcount to ensure that the channel
  526.                  * is only closed on exit.
  527.                  *
  528.                  * NOTE: Must only do this if stderrChannel is not NULL. It
  529.                  * can be NULL in situations where Tcl is unable to connect
  530.                  * to the standard error.
  531.                  */
  532.  
  533.                 if (stderrChannel != (Tcl_Channel) NULL) {
  534.                     (void) Tcl_RegisterChannel((Tcl_Interp *) NULL,
  535.                             stderrChannel);
  536.                 }
  537.         }
  538.         channel = stderrChannel;
  539.         break;
  540.     }
  541.     return channel;
  542. }
  543.  
  544. /*
  545.  *----------------------------------------------------------------------
  546.  *
  547.  * Tcl_CreateCloseHandler
  548.  *
  549.  *    Creates a close callback which will be called when the channel is
  550.  *    closed.
  551.  *
  552.  * Results:
  553.  *    None.
  554.  *
  555.  * Side effects:
  556.  *    Causes the callback to be called in the future when the channel
  557.  *    will be closed.
  558.  *
  559.  *----------------------------------------------------------------------
  560.  */
  561.  
  562. void
  563. Tcl_CreateCloseHandler(chan, proc, clientData)
  564.     Tcl_Channel chan;        /* The channel for which to create the
  565.                                  * close callback. */
  566.     Tcl_CloseProc *proc;    /* The callback routine to call when the
  567.                                  * channel will be closed. */
  568.     ClientData clientData;    /* Arbitrary data to pass to the
  569.                                  * close callback. */
  570. {
  571.     Channel *chanPtr;
  572.     CloseCallback *cbPtr;
  573.  
  574.     chanPtr = (Channel *) chan;
  575.  
  576.     cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
  577.     cbPtr->proc = proc;
  578.     cbPtr->clientData = clientData;
  579.  
  580.     cbPtr->nextPtr = chanPtr->closeCbPtr;
  581.     chanPtr->closeCbPtr = cbPtr;
  582. }
  583.  
  584. /*
  585.  *----------------------------------------------------------------------
  586.  *
  587.  * Tcl_DeleteCloseHandler --
  588.  *
  589.  *    Removes a callback that would have been called on closing
  590.  *    the channel. If there is no matching callback then this
  591.  *    function has no effect.
  592.  *
  593.  * Results:
  594.  *    None.
  595.  *
  596.  * Side effects:
  597.  *    The callback will not be called in the future when the channel
  598.  *    is eventually closed.
  599.  *
  600.  *----------------------------------------------------------------------
  601.  */
  602.  
  603. void
  604. Tcl_DeleteCloseHandler(chan, proc, clientData)
  605.     Tcl_Channel chan;        /* The channel for which to cancel the
  606.                                  * close callback. */
  607.     Tcl_CloseProc *proc;    /* The procedure for the callback to
  608.                                  * remove. */
  609.     ClientData clientData;    /* The callback data for the callback
  610.                                  * to remove. */
  611. {
  612.     Channel *chanPtr;
  613.     CloseCallback *cbPtr, *cbPrevPtr;
  614.  
  615.     chanPtr = (Channel *) chan;
  616.     for (cbPtr = chanPtr->closeCbPtr, cbPrevPtr = (CloseCallback *) NULL;
  617.              cbPtr != (CloseCallback *) NULL;
  618.              cbPtr = cbPtr->nextPtr) {
  619.         if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
  620.             if (cbPrevPtr == (CloseCallback *) NULL) {
  621.                 chanPtr->closeCbPtr = cbPtr->nextPtr;
  622.             }
  623.             ckfree((char *) cbPtr);
  624.             break;
  625.         } else {
  626.             cbPrevPtr = cbPtr;
  627.         }
  628.     }
  629. }
  630.  
  631. /*
  632.  *----------------------------------------------------------------------
  633.  *
  634.  * CloseChannelsOnExit --
  635.  *
  636.  *    Closes all the existing channels, on exit. This    routine is called
  637.  *    during exit processing.
  638.  *
  639.  * Results:
  640.  *    None.
  641.  *
  642.  * Side effects:
  643.  *    Closes all channels.
  644.  *
  645.  *----------------------------------------------------------------------
  646.  */
  647.  
  648.     /* ARGSUSED */
  649. static void
  650. CloseChannelsOnExit(clientData)
  651.     ClientData clientData;        /* NULL - unused. */
  652. {
  653.     Channel *chanPtr;            /* Iterates over open channels. */
  654.     Channel *nextChanPtr;        /* Iterates over open channels. */
  655.  
  656.  
  657.     for (chanPtr = firstChanPtr; chanPtr != (Channel *) NULL;
  658.              chanPtr = nextChanPtr) {
  659.         nextChanPtr = chanPtr->nextChanPtr;
  660.  
  661.         /*
  662.          * Set the channel back into blocking mode to ensure that we wait
  663.          * for all data to flush out.
  664.          */
  665.         
  666.         (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
  667.                 "-blocking", "on");
  668.  
  669.         if ((chanPtr == (Channel *) stdinChannel) ||
  670.                 (chanPtr == (Channel *) stdoutChannel) ||
  671.                 (chanPtr == (Channel *) stderrChannel)) {
  672.  
  673.             /*
  674.              * Decrement the refcount which was earlier artificially bumped
  675.              * up to keep the channel from being closed.
  676.              */
  677.  
  678.             chanPtr->refCount--;
  679.         }
  680.  
  681.         if (chanPtr->refCount <= 0) {
  682.  
  683.         /*
  684.              * Close it only if the refcount indicates that the channel is not
  685.              * referenced from any interpreter. If it is, that interpreter will
  686.              * close the channel when it gets destroyed.
  687.              */
  688.  
  689.             (void) Tcl_Close((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
  690.  
  691.         } else {
  692.  
  693.             /*
  694.              * The refcount is greater than zero, so flush the channel.
  695.              */
  696.  
  697.             Tcl_Flush((Tcl_Channel) chanPtr);
  698.  
  699.             /*
  700.              * Call the device driver to actually close the underlying
  701.              * device for this channel.
  702.              */
  703.             
  704.             (chanPtr->typePtr->closeProc) (chanPtr->instanceData,
  705.                     (Tcl_Interp *) NULL);
  706.  
  707.             /*
  708.              * Finally, we clean up the fields in the channel data structure
  709.              * since all of them have been deleted already. We mark the
  710.              * channel with CHANNEL_DEAD to prevent any further IO operations
  711.              * on it.
  712.              */
  713.  
  714.             chanPtr->instanceData = (ClientData) NULL;
  715.             chanPtr->flags |= CHANNEL_DEAD;
  716.         }
  717.     }
  718.  
  719.     /*
  720.      * Reinitialize all the variables to the initial state:
  721.      */
  722.     
  723.     firstChanPtr = (Channel *) NULL;
  724.     nestedHandlerPtr = (NextChannelHandler *) NULL;
  725.     channelExitHandlerCreated = 0;
  726.     stdinChannel = NULL;
  727.     stdinInitialized = 0;
  728.     stdoutChannel = NULL;
  729.     stdoutInitialized = 0;
  730.     stderrChannel = NULL;
  731.     stderrInitialized = 0;
  732. }
  733.  
  734. /*
  735.  *----------------------------------------------------------------------
  736.  *
  737.  * GetChannelTable --
  738.  *
  739.  *    Gets and potentially initializes the channel table for an
  740.  *    interpreter. If it is initializing the table it also inserts
  741.  *    channels for stdin, stdout and stderr if the interpreter is
  742.  *    trusted.
  743.  *
  744.  * Results:
  745.  *    A pointer to the hash table created, for use by the caller.
  746.  *
  747.  * Side effects:
  748.  *    Initializes the channel table for an interpreter. May create
  749.  *    channels for stdin, stdout and stderr.
  750.  *
  751.  *----------------------------------------------------------------------
  752.  */
  753.  
  754. static Tcl_HashTable *
  755. GetChannelTable(interp)
  756.     Tcl_Interp *interp;
  757. {
  758.     Tcl_HashTable *hTblPtr;    /* Hash table of channels. */
  759.     Tcl_Channel stdinChan, stdoutChan, stderrChan;
  760.  
  761.     hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
  762.     if (hTblPtr == (Tcl_HashTable *) NULL) {
  763.         hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
  764.         Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
  765.  
  766.         (void) Tcl_SetAssocData(interp, "tclIO",
  767.                 (Tcl_InterpDeleteProc *) DeleteChannelTable,
  768.                 (ClientData) hTblPtr);
  769.  
  770.         /*
  771.          * If the interpreter is trusted (not "safe"), insert channels
  772.          * for stdin, stdout and stderr (possibly creating them in the
  773.          * process).
  774.          */
  775.  
  776.         if (Tcl_IsSafe(interp) == 0) {
  777.             stdinChan = Tcl_GetStdChannel(TCL_STDIN);
  778.             if (stdinChan != NULL) {
  779.                 Tcl_RegisterChannel(interp, stdinChan);
  780.             }
  781.             stdoutChan = Tcl_GetStdChannel(TCL_STDOUT);
  782.             if (stdoutChan != NULL) {
  783.                 Tcl_RegisterChannel(interp, stdoutChan);
  784.             }
  785.             stderrChan = Tcl_GetStdChannel(TCL_STDERR);
  786.             if (stderrChan != NULL) {
  787.                 Tcl_RegisterChannel(interp, stderrChan);
  788.             }
  789.         }
  790.  
  791.     }
  792.     return hTblPtr;
  793. }
  794.  
  795. /*
  796.  *----------------------------------------------------------------------
  797.  *
  798.  * DeleteChannelTable --
  799.  *
  800.  *    Deletes the channel table for an interpreter, closing any open
  801.  *    channels whose refcount reaches zero. This procedure is invoked
  802.  *    when an interpreter is deleted, via the AssocData cleanup
  803.  *    mechanism.
  804.  *
  805.  * Results:
  806.  *    None.
  807.  *
  808.  * Side effects:
  809.  *    Deletes the hash table of channels. May close channels. May flush
  810.  *    output on closed channels. Removes any channeEvent handlers that were
  811.  *    registered in this interpreter.
  812.  *
  813.  *----------------------------------------------------------------------
  814.  */
  815.  
  816. static void
  817. DeleteChannelTable(clientData, interp)
  818.     ClientData clientData;    /* The per-interpreter data structure. */
  819.     Tcl_Interp *interp;        /* The interpreter being deleted. */
  820. {
  821.     Tcl_HashTable *hTblPtr;    /* The hash table. */
  822.     Tcl_HashSearch hSearch;    /* Search variable. */
  823.     Tcl_HashEntry *hPtr;    /* Search variable. */
  824.     Channel *chanPtr;    /* Channel being deleted. */
  825.     EventScriptRecord *sPtr, *prevPtr, *nextPtr;
  826.                     /* Variables to loop over all channel events
  827.                                  * registered, to delete the ones that refer
  828.                                  * to the interpreter being deleted. */
  829.     
  830.     /*
  831.      * Delete all the registered channels - this will close channels whose
  832.      * refcount reaches zero.
  833.      */
  834.     
  835.     hTblPtr = (Tcl_HashTable *) clientData;
  836.     for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
  837.              hPtr != (Tcl_HashEntry *) NULL;
  838.              hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
  839.  
  840.         chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
  841.  
  842.         /*
  843.          * Remove any fileevents registered in this interpreter.
  844.          */
  845.         
  846.         for (sPtr = chanPtr->scriptRecordPtr,
  847.                  prevPtr = (EventScriptRecord *) NULL;
  848.                  sPtr != (EventScriptRecord *) NULL;
  849.                  sPtr = nextPtr) {
  850.             nextPtr = sPtr->nextPtr;
  851.             if (sPtr->interp == interp) {
  852.                 if (prevPtr == (EventScriptRecord *) NULL) {
  853.                     chanPtr->scriptRecordPtr = nextPtr;
  854.                 } else {
  855.                     prevPtr->nextPtr = nextPtr;
  856.                 }
  857.  
  858.                 Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
  859.                         ChannelEventScriptInvoker, (ClientData) sPtr);
  860.  
  861.         ckfree(sPtr->script);
  862.                 ckfree((char *) sPtr);
  863.             } else {
  864.                 prevPtr = sPtr;
  865.             }
  866.         }
  867.  
  868.         /*
  869.          * Cannot call Tcl_UnregisterChannel because that procedure calls
  870.          * Tcl_GetAssocData to get the channel table, which might already
  871.          * be inaccessible from the interpreter structure. Instead, we
  872.          * emulate the behavior of Tcl_UnregisterChannel directly here.
  873.          */
  874.  
  875.         Tcl_DeleteHashEntry(hPtr);
  876.         chanPtr->refCount--;
  877.         if (chanPtr->refCount <= 0) {
  878.             if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
  879.                 (void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
  880.             }
  881.         }
  882.     }
  883.     Tcl_DeleteHashTable(hTblPtr);
  884.     ckfree((char *) hTblPtr);
  885. }
  886.  
  887. /*
  888.  *----------------------------------------------------------------------
  889.  *
  890.  * CheckForStdChannelsBeingClosed --
  891.  *
  892.  *    Perform special handling for standard channels being closed. When
  893.  *    given a standard channel, if the refcount is now 1, it means that
  894.  *    the last reference to the standard channel is being explicitly
  895.  *    closed. Now bump the refcount artificially down to 0, to ensure the
  896.  *    normal handling of channels being closed will occur. Also reset the
  897.  *    static pointer to the channel to NULL, to avoid dangling references.
  898.  *
  899.  * Results:
  900.  *    None.
  901.  *
  902.  * Side effects:
  903.  *    Manipulates the refcount on standard channels. May smash the global
  904.  *    static pointer to a standard channel.
  905.  *
  906.  *----------------------------------------------------------------------
  907.  */
  908.  
  909. static void
  910. CheckForStdChannelsBeingClosed(chan)
  911.     Tcl_Channel chan;
  912. {
  913.     Channel *chanPtr = (Channel *) chan;
  914.     
  915.     if ((chan == stdinChannel) && (stdinInitialized)) {
  916.         if (chanPtr->refCount < 2) {
  917.             chanPtr->refCount = 0;
  918.             stdinChannel = NULL;
  919.             return;
  920.         }
  921.     } else if ((chan == stdoutChannel) && (stdoutInitialized)) {
  922.         if (chanPtr->refCount < 2) {
  923.             chanPtr->refCount = 0;
  924.             stdoutChannel = NULL;
  925.             return;
  926.         }
  927.     } else if ((chan == stderrChannel) && (stderrInitialized)) {
  928.         if (chanPtr->refCount < 2) {
  929.             chanPtr->refCount = 0;
  930.             stderrChannel = NULL;
  931.             return;
  932.         }
  933.     }
  934. }
  935.  
  936. /*
  937.  *----------------------------------------------------------------------
  938.  *
  939.  * Tcl_UnregisterChannel --
  940.  *
  941.  *    Deletes the hash entry for a channel associated with an interpreter.
  942.  *    If the interpreter given as argument is NULL, it only decrements the
  943.  *    reference count.
  944.  *
  945.  * Results:
  946.  *    A standard Tcl result.
  947.  *
  948.  * Side effects:
  949.  *    Deletes the hash entry for a channel associated with an interpreter.
  950.  *
  951.  *----------------------------------------------------------------------
  952.  */
  953.  
  954. int
  955. Tcl_UnregisterChannel(interp, chan)
  956.     Tcl_Interp *interp;        /* Interpreter in which channel is defined. */
  957.     Tcl_Channel chan;        /* Channel to delete. */
  958. {
  959.     Tcl_HashTable *hTblPtr;    /* Hash table of channels. */
  960.     Tcl_HashEntry *hPtr;    /* Search variable. */
  961.     Channel *chanPtr;        /* The real IO channel. */
  962.  
  963.     chanPtr = (Channel *) chan;
  964.     
  965.     if (interp != (Tcl_Interp *) NULL) {
  966.         hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
  967.         if (hTblPtr == (Tcl_HashTable *) NULL) {
  968.             return TCL_OK;
  969.         }
  970.         hPtr = Tcl_FindHashEntry(hTblPtr, chanPtr->channelName);
  971.         if (hPtr == (Tcl_HashEntry *) NULL) {
  972.             return TCL_OK;
  973.         }
  974.         if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
  975.             return TCL_OK;
  976.         }
  977.         Tcl_DeleteHashEntry(hPtr);
  978.  
  979.         /*
  980.          * Remove channel handlers that refer to this interpreter, so that they
  981.          * will not be present if the actual close is delayed and more events
  982.          * happen on the channel. This may occur if the channel is shared
  983.          * between several interpreters, or if the channel has async
  984.          * flushing active.
  985.          */
  986.     
  987.         CleanupChannelHandlers(interp, chanPtr);
  988.     }
  989.  
  990.     chanPtr->refCount--;
  991.     
  992.     /*
  993.      * Perform special handling for standard channels being closed. If the
  994.      * refCount is now 1 it means that the last reference to the standard
  995.      * channel is being explicitly closed, so bump the refCount down
  996.      * artificially to 0. This will ensure that the channel is actually
  997.      * closed, below. Also set the static pointer to NULL for the channel.
  998.      */
  999.  
  1000.     CheckForStdChannelsBeingClosed(chan);
  1001.  
  1002.     /*
  1003.      * If the refCount reached zero, close the actual channel.
  1004.      */
  1005.  
  1006.     if (chanPtr->refCount <= 0) {
  1007.  
  1008.         /*
  1009.          * Ensure that if there is another buffer, it gets flushed
  1010.          * whether or not we are doing a background flush.
  1011.          */
  1012.  
  1013.         if ((chanPtr->curOutPtr != NULL) &&
  1014.                 (chanPtr->curOutPtr->nextAdded >
  1015.                         chanPtr->curOutPtr->nextRemoved)) {
  1016.             chanPtr->flags |= BUFFER_READY;
  1017.         }
  1018.         chanPtr->flags |= CHANNEL_CLOSED;
  1019.         if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
  1020.             if (Tcl_Close(interp, chan) != TCL_OK) {
  1021.                 return TCL_ERROR;
  1022.             }
  1023.         }
  1024.     }
  1025.     return TCL_OK;
  1026. }
  1027.  
  1028. /*
  1029.  *----------------------------------------------------------------------
  1030.  *
  1031.  * Tcl_RegisterChannel --
  1032.  *
  1033.  *    Adds an already-open channel to the channel table of an interpreter.
  1034.  *    If the interpreter passed as argument is NULL, it only increments
  1035.  *    the channel refCount.
  1036.  *
  1037.  * Results:
  1038.  *    None.
  1039.  *
  1040.  * Side effects:
  1041.  *    May increment the reference count of a channel.
  1042.  *
  1043.  *----------------------------------------------------------------------
  1044.  */
  1045.  
  1046. void
  1047. Tcl_RegisterChannel(interp, chan)
  1048.     Tcl_Interp *interp;        /* Interpreter in which to add the channel. */
  1049.     Tcl_Channel chan;        /* The channel to add to this interpreter
  1050.                                  * channel table. */
  1051. {
  1052.     Tcl_HashTable *hTblPtr;    /* Hash table of channels. */
  1053.     Tcl_HashEntry *hPtr;    /* Search variable. */
  1054.     int new;            /* Is the hash entry new or does it exist? */
  1055.     Channel *chanPtr;        /* The actual channel. */
  1056.  
  1057.     chanPtr = (Channel *) chan;
  1058.  
  1059.     if (chanPtr->channelName == (char *) NULL) {
  1060.         panic("Tcl_RegisterChannel: channel without name");
  1061.     }
  1062.     if (interp != (Tcl_Interp *) NULL) {
  1063.         hTblPtr = GetChannelTable(interp);
  1064.         hPtr = Tcl_CreateHashEntry(hTblPtr, chanPtr->channelName, &new);
  1065.         if (new == 0) {
  1066.             if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
  1067.                 return;
  1068.             }
  1069.             panic("Tcl_RegisterChannel: duplicate channel names");
  1070.         }
  1071.         Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
  1072.     }
  1073.     chanPtr->refCount++;
  1074. }
  1075.  
  1076. /*
  1077.  *----------------------------------------------------------------------
  1078.  *
  1079.  * Tcl_GetChannel --
  1080.  *
  1081.  *    Finds an existing Tcl_Channel structure by name in a given
  1082.  *    interpreter. This function is public because it is used by
  1083.  *    channel-type-specific functions.
  1084.  *
  1085.  * Results:
  1086.  *    A Tcl_Channel or NULL on failure. If failed, interp->result
  1087.  *    contains an error message. It also returns, in modePtr, the
  1088.  *    modes in which the channel is opened.
  1089.  *
  1090.  * Side effects:
  1091.  *    None.
  1092.  *
  1093.  *----------------------------------------------------------------------
  1094.  */
  1095.  
  1096. Tcl_Channel
  1097. Tcl_GetChannel(interp, chanName, modePtr)
  1098.     Tcl_Interp *interp;        /* Interpreter in which to find or create
  1099.                                  * the channel. */
  1100.     char *chanName;        /* The name of the channel. */
  1101.     int *modePtr;        /* Where to store the mode in which the
  1102.                                  * channel was opened? Will contain an ORed
  1103.                                  * combination of TCL_READABLE and
  1104.                                  * TCL_WRITABLE, if non-NULL. */
  1105. {
  1106.     Channel *chanPtr;        /* The actual channel. */
  1107.     Tcl_HashTable *hTblPtr;    /* Hash table of channels. */
  1108.     Tcl_HashEntry *hPtr;    /* Search variable. */
  1109.     char *name;            /* Translated name. */
  1110.  
  1111.     /*
  1112.      * Substitute "stdin", etc.  Note that even though we immediately
  1113.      * find the channel using Tcl_GetStdChannel, we still need to look
  1114.      * it up in the specified interpreter to ensure that it is present
  1115.      * in the channel table.  Otherwise, safe interpreters would always
  1116.      * have access to the standard channels.
  1117.      */
  1118.  
  1119.     name = chanName;
  1120.     if ((chanName[0] == 's') && (chanName[1] == 't')) {
  1121.     chanPtr = NULL;
  1122.     if (strcmp(chanName, "stdin") == 0) {
  1123.         chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDIN);
  1124.     } else if (strcmp(chanName, "stdout") == 0) {
  1125.         chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDOUT);
  1126.     } else if (strcmp(chanName, "stderr") == 0) {
  1127.         chanPtr = (Channel *)Tcl_GetStdChannel(TCL_STDERR);
  1128.     }
  1129.     if (chanPtr != NULL) {
  1130.         name = chanPtr->channelName;
  1131.     }
  1132.     }
  1133.     
  1134.     hTblPtr = GetChannelTable(interp);
  1135.     hPtr = Tcl_FindHashEntry(hTblPtr, name);
  1136.     if (hPtr == (Tcl_HashEntry *) NULL) {
  1137.         Tcl_AppendResult(interp, "can not find channel named \"",
  1138.                 chanName, "\"", (char *) NULL);
  1139.         return NULL;
  1140.     }
  1141.  
  1142.     chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
  1143.     if (modePtr != NULL) {
  1144.         *modePtr = (chanPtr->flags & (TCL_READABLE|TCL_WRITABLE));
  1145.     }
  1146.     
  1147.     return (Tcl_Channel) chanPtr;
  1148. }
  1149.  
  1150. /*
  1151.  *----------------------------------------------------------------------
  1152.  *
  1153.  * Tcl_CreateChannel --
  1154.  *
  1155.  *    Creates a new entry in the hash table for a Tcl_Channel
  1156.  *    record.
  1157.  *
  1158.  * Results:
  1159.  *    Returns the new Tcl_Channel.
  1160.  *
  1161.  * Side effects:
  1162.  *    Creates a new Tcl_Channel instance and inserts it into the
  1163.  *    hash table.
  1164.  *
  1165.  *----------------------------------------------------------------------
  1166.  */
  1167.  
  1168. Tcl_Channel
  1169. Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
  1170.     Tcl_ChannelType *typePtr;    /* The channel type record. */
  1171.     char *chanName;        /* Name of channel to record. */
  1172.     ClientData instanceData;    /* Instance specific data. */
  1173.     int mask;            /* TCL_READABLE & TCL_WRITABLE to indicate
  1174.                                  * if the channel is readable, writable. */
  1175. {
  1176.     Channel *chanPtr;        /* The channel structure newly created. */
  1177.  
  1178.     chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
  1179.     
  1180.     if (chanName != (char *) NULL) {
  1181.         chanPtr->channelName = ckalloc((unsigned) (strlen(chanName) + 1));
  1182.         strcpy(chanPtr->channelName, chanName);
  1183.     } else {
  1184.         panic("Tcl_CreateChannel: NULL channel name");
  1185.     }
  1186.  
  1187.     chanPtr->flags = mask;
  1188.  
  1189.     /*
  1190.      * Set the channel up initially in AUTO input translation mode to
  1191.      * accept "\n", "\r" and "\r\n". Output translation mode is set to
  1192.      * a platform specific default value. The eofChar is set to 0 for both
  1193.      * input and output, so that Tcl does not look for an in-file EOF
  1194.      * indicator (e.g. ^Z) and does not append an EOF indicator to files.
  1195.      */
  1196.  
  1197.     chanPtr->inputTranslation = TCL_TRANSLATE_AUTO;
  1198.     chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
  1199.     chanPtr->inEofChar = 0;
  1200.     chanPtr->outEofChar = 0;
  1201.  
  1202.     chanPtr->unreportedError = 0;
  1203.     chanPtr->instanceData = instanceData;
  1204.     chanPtr->typePtr = typePtr;
  1205.     chanPtr->refCount = 0;
  1206.     chanPtr->closeCbPtr = (CloseCallback *) NULL;
  1207.     chanPtr->curOutPtr = (ChannelBuffer *) NULL;
  1208.     chanPtr->outQueueHead = (ChannelBuffer *) NULL;
  1209.     chanPtr->outQueueTail = (ChannelBuffer *) NULL;
  1210.     chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
  1211.     chanPtr->inQueueHead = (ChannelBuffer *) NULL;
  1212.     chanPtr->inQueueTail = (ChannelBuffer *) NULL;
  1213.     chanPtr->chPtr = (ChannelHandler *) NULL;
  1214.     chanPtr->interestMask = 0;
  1215.     chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
  1216.     chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
  1217.     chanPtr->timer = NULL;
  1218.     chanPtr->csPtr = NULL;
  1219.  
  1220.     /*
  1221.      * Link the channel into the list of all channels; create an on-exit
  1222.      * handler if there is not one already, to close off all the channels
  1223.      * in the list on exit.
  1224.      */
  1225.  
  1226.     chanPtr->nextChanPtr = firstChanPtr;
  1227.     firstChanPtr = chanPtr;
  1228.  
  1229.     if (!channelExitHandlerCreated) {
  1230.         channelExitHandlerCreated = 1;
  1231.         Tcl_CreateExitHandler(CloseChannelsOnExit, (ClientData) NULL);
  1232.     }
  1233.     
  1234.     /*
  1235.      * Install this channel in the first empty standard channel slot, if
  1236.      * the channel was previously closed explicitly.
  1237.      */
  1238.  
  1239.     if ((stdinChannel == NULL) && (stdinInitialized == 1)) {
  1240.     Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDIN);
  1241.         Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
  1242.     } else if ((stdoutChannel == NULL) && (stdoutInitialized == 1)) {
  1243.     Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDOUT);
  1244.         Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
  1245.     } else if ((stderrChannel == NULL) && (stderrInitialized == 1)) {
  1246.     Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDERR);
  1247.         Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
  1248.     } 
  1249.     return (Tcl_Channel) chanPtr;
  1250. }
  1251.  
  1252. /*
  1253.  *----------------------------------------------------------------------
  1254.  *
  1255.  * Tcl_GetChannelMode --
  1256.  *
  1257.  *    Computes a mask indicating whether the channel is open for
  1258.  *    reading and writing.
  1259.  *
  1260.  * Results:
  1261.  *    An OR-ed combination of TCL_READABLE and TCL_WRITABLE.
  1262.  *
  1263.  * Side effects:
  1264.  *    None.
  1265.  *
  1266.  *----------------------------------------------------------------------
  1267.  */
  1268.  
  1269. int
  1270. Tcl_GetChannelMode(chan)
  1271.     Tcl_Channel chan;        /* The channel for which the mode is
  1272.                                  * being computed. */
  1273. {
  1274.     Channel *chanPtr;        /* The actual channel. */
  1275.  
  1276.     chanPtr = (Channel *) chan;
  1277.     return (chanPtr->flags & (TCL_READABLE | TCL_WRITABLE));
  1278. }
  1279.  
  1280. /*
  1281.  *----------------------------------------------------------------------
  1282.  *
  1283.  * Tcl_GetChannelName --
  1284.  *
  1285.  *    Returns the string identifying the channel name.
  1286.  *
  1287.  * Results:
  1288.  *    The string containing the channel name. This memory is
  1289.  *    owned by the generic layer and should not be modified by
  1290.  *    the caller.
  1291.  *
  1292.  * Side effects:
  1293.  *    None.
  1294.  *
  1295.  *----------------------------------------------------------------------
  1296.  */
  1297.  
  1298. char *
  1299. Tcl_GetChannelName(chan)
  1300.     Tcl_Channel chan;        /* The channel for which to return the name. */
  1301. {
  1302.     Channel *chanPtr;        /* The actual channel. */
  1303.  
  1304.     chanPtr = (Channel *) chan;
  1305.     return chanPtr->channelName;
  1306. }
  1307.  
  1308. /*
  1309.  *----------------------------------------------------------------------
  1310.  *
  1311.  * Tcl_GetChannelType --
  1312.  *
  1313.  *    Given a channel structure, returns the channel type structure.
  1314.  *
  1315.  * Results:
  1316.  *    Returns a pointer to the channel type structure.
  1317.  *
  1318.  * Side effects:
  1319.  *    None.
  1320.  *
  1321.  *----------------------------------------------------------------------
  1322.  */
  1323.  
  1324. Tcl_ChannelType *
  1325. Tcl_GetChannelType(chan)
  1326.     Tcl_Channel chan;        /* The channel to return type for. */
  1327. {
  1328.     Channel *chanPtr;        /* The actual channel. */
  1329.  
  1330.     chanPtr = (Channel *) chan;
  1331.     return chanPtr->typePtr;
  1332. }
  1333.  
  1334. /*
  1335.  *----------------------------------------------------------------------
  1336.  *
  1337.  * Tcl_GetChannelHandle --
  1338.  *
  1339.  *    Returns an OS handle associated with a channel.
  1340.  *
  1341.  * Results:
  1342.  *    Returns TCL_OK and places the handle in handlePtr, or returns
  1343.  *    TCL_ERROR on failure.
  1344.  *
  1345.  * Side effects:
  1346.  *    None.
  1347.  *
  1348.  *----------------------------------------------------------------------
  1349.  */
  1350.  
  1351. int
  1352. Tcl_GetChannelHandle(chan, direction, handlePtr)
  1353.     Tcl_Channel chan;        /* The channel to get file from. */
  1354.     int direction;        /* TCL_WRITABLE or TCL_READABLE. */
  1355.     ClientData *handlePtr;    /* Where to store handle */
  1356. {
  1357.     Channel *chanPtr;        /* The actual channel. */
  1358.     ClientData handle;
  1359.     int result;
  1360.  
  1361.     chanPtr = (Channel *) chan;
  1362.     result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
  1363.         direction, &handle);
  1364.     if (handlePtr) {
  1365.     *handlePtr = handle;
  1366.     }
  1367.     return result;
  1368. }
  1369.  
  1370. /*
  1371.  *----------------------------------------------------------------------
  1372.  *
  1373.  * Tcl_GetChannelInstanceData --
  1374.  *
  1375.  *    Returns the client data associated with a channel.
  1376.  *
  1377.  * Results:
  1378.  *    The client data.
  1379.  *
  1380.  * Side effects:
  1381.  *    None.
  1382.  *
  1383.  *----------------------------------------------------------------------
  1384.  */
  1385.  
  1386. ClientData
  1387. Tcl_GetChannelInstanceData(chan)
  1388.     Tcl_Channel chan;        /* Channel for which to return client data. */
  1389. {
  1390.     Channel *chanPtr;        /* The actual channel. */
  1391.  
  1392.     chanPtr = (Channel *) chan;
  1393.     return chanPtr->instanceData;
  1394. }
  1395.  
  1396. /*
  1397.  *----------------------------------------------------------------------
  1398.  *
  1399.  * RecycleBuffer --
  1400.  *
  1401.  *    Helper function to recycle input and output buffers. Ensures
  1402.  *    that two input buffers are saved (one in the input queue and
  1403.  *    another in the saveInBufPtr field) and that curOutPtr is set
  1404.  *    to a buffer. Only if these conditions are met is the buffer
  1405.  *    freed to the OS.
  1406.  *
  1407.  * Results:
  1408.  *    None.
  1409.  *
  1410.  * Side effects:
  1411.  *    May free a buffer to the OS.
  1412.  *
  1413.  *----------------------------------------------------------------------
  1414.  */
  1415.  
  1416. static void
  1417. RecycleBuffer(chanPtr, bufPtr, mustDiscard)
  1418.     Channel *chanPtr;        /* Channel for which to recycle buffers. */
  1419.     ChannelBuffer *bufPtr;    /* The buffer to recycle. */
  1420.     int mustDiscard;        /* If nonzero, free the buffer to the
  1421.                                  * OS, always. */
  1422. {
  1423.     /*
  1424.      * Do we have to free the buffer to the OS?
  1425.      */
  1426.  
  1427.     if (mustDiscard) {
  1428.         ckfree((char *) bufPtr);
  1429.         return;
  1430.     }
  1431.     
  1432.     /*
  1433.      * Only save buffers for the input queue if the channel is readable.
  1434.      */
  1435.     
  1436.     if (chanPtr->flags & TCL_READABLE) {
  1437.         if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
  1438.             chanPtr->inQueueHead = bufPtr;
  1439.             chanPtr->inQueueTail = bufPtr;
  1440.             goto keepit;
  1441.         }
  1442.         if (chanPtr->saveInBufPtr == (ChannelBuffer *) NULL) {
  1443.             chanPtr->saveInBufPtr = bufPtr;
  1444.             goto keepit;
  1445.         }
  1446.     }
  1447.  
  1448.     /*
  1449.      * Only save buffers for the output queue if the channel is writable.
  1450.      */
  1451.  
  1452.     if (chanPtr->flags & TCL_WRITABLE) {
  1453.         if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
  1454.             chanPtr->curOutPtr = bufPtr;
  1455.             goto keepit;
  1456.         }
  1457.     }
  1458.  
  1459.     /*
  1460.      * If we reached this code we return the buffer to the OS.
  1461.      */
  1462.  
  1463.     ckfree((char *) bufPtr);
  1464.     return;
  1465.  
  1466. keepit:
  1467.     bufPtr->nextRemoved = 0;
  1468.     bufPtr->nextAdded = 0;
  1469.     bufPtr->nextPtr = (ChannelBuffer *) NULL;
  1470. }
  1471.  
  1472. /*
  1473.  *----------------------------------------------------------------------
  1474.  *
  1475.  * DiscardOutputQueued --
  1476.  *
  1477.  *    Discards all output queued in the output queue of a channel.
  1478.  *
  1479.  * Results:
  1480.  *    None.
  1481.  *
  1482.  * Side effects:
  1483.  *    Recycles buffers.
  1484.  *
  1485.  *----------------------------------------------------------------------
  1486.  */
  1487.  
  1488. static void
  1489. DiscardOutputQueued(chanPtr)
  1490.     Channel *chanPtr;        /* The channel for which to discard output. */
  1491. {
  1492.     ChannelBuffer *bufPtr;
  1493.     
  1494.     while (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
  1495.         bufPtr = chanPtr->outQueueHead;
  1496.         chanPtr->outQueueHead = bufPtr->nextPtr;
  1497.         RecycleBuffer(chanPtr, bufPtr, 0);
  1498.     }
  1499.     chanPtr->outQueueHead = (ChannelBuffer *) NULL;
  1500.     chanPtr->outQueueTail = (ChannelBuffer *) NULL;
  1501. }
  1502.  
  1503. /*
  1504.  *----------------------------------------------------------------------
  1505.  *
  1506.  * CheckForDeadChannel --
  1507.  *
  1508.  *    This function checks is a given channel is Dead.
  1509.  *      (A channel that has been closed but not yet deallocated.)
  1510.  *
  1511.  * Results:
  1512.  *    True (1) if channel is Dead, False (0) if channel is Ok
  1513.  *
  1514.  * Side effects:
  1515.  *      None
  1516.  *
  1517.  *----------------------------------------------------------------------
  1518.  */
  1519.  
  1520. static int
  1521. CheckForDeadChannel(interp, chanPtr)
  1522.     Tcl_Interp *interp;        /* For error reporting (can be NULL) */
  1523.     Channel    *chanPtr;    /* The channel to check. */
  1524. {
  1525.     if (chanPtr->flags & CHANNEL_DEAD) {
  1526.         Tcl_SetErrno(EINVAL);
  1527.     if (interp) {
  1528.         Tcl_AppendResult(interp,
  1529.                  "unable to access channel: invalid channel",
  1530.                  (char *) NULL);   
  1531.     }
  1532.     return 1;
  1533.     }
  1534.     return 0;
  1535. }
  1536.  
  1537. /*
  1538.  *----------------------------------------------------------------------
  1539.  *
  1540.  * FlushChannel --
  1541.  *
  1542.  *    This function flushes as much of the queued output as is possible
  1543.  *    now. If calledFromAsyncFlush is nonzero, it is being called in an
  1544.  *    event handler to flush channel output asynchronously.
  1545.  *
  1546.  * Results:
  1547.  *    0 if successful, else the error code that was returned by the
  1548.  *    channel type operation.
  1549.  *
  1550.  * Side effects:
  1551.  *    May produce output on a channel. May block indefinitely if the
  1552.  *    channel is synchronous. May schedule an async flush on the channel.
  1553.  *    May recycle memory for buffers in the output queue.
  1554.  *
  1555.  *----------------------------------------------------------------------
  1556.  */
  1557.  
  1558. static int
  1559. FlushChannel(interp, chanPtr, calledFromAsyncFlush)
  1560.     Tcl_Interp *interp;            /* For error reporting during close. */
  1561.     Channel *chanPtr;            /* The channel to flush on. */
  1562.     int calledFromAsyncFlush;        /* If nonzero then we are being
  1563.                                          * called from an asynchronous
  1564.                                          * flush callback. */
  1565. {
  1566.     ChannelBuffer *bufPtr;        /* Iterates over buffered output
  1567.                                          * queue. */
  1568.     int toWrite;            /* Amount of output data in current
  1569.                                          * buffer available to be written. */
  1570.     int written;            /* Amount of output data actually
  1571.                                          * written in current round. */
  1572.     int errorCode;            /* Stores POSIX error codes from
  1573.                                          * channel driver operations. */
  1574.     errorCode = 0;
  1575.  
  1576.     /*
  1577.      * Prevent writing on a dead channel -- a channel that has been closed
  1578.      * but not yet deallocated. This can occur if the exit handler for the
  1579.      * channel deallocation runs before all channels are deregistered in
  1580.      * all interpreters.
  1581.      */
  1582.     
  1583.     if (CheckForDeadChannel(interp,chanPtr)) return -1;
  1584.     
  1585.     /*
  1586.      * Loop over the queued buffers and attempt to flush as
  1587.      * much as possible of the queued output to the channel.
  1588.      */
  1589.  
  1590.     while (1) {
  1591.  
  1592.         /*
  1593.          * If the queue is empty and there is a ready current buffer, OR if
  1594.          * the current buffer is full, then move the current buffer to the
  1595.          * queue.
  1596.          */
  1597.         
  1598.         if (((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
  1599.                 (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufSize))
  1600.                 || ((chanPtr->flags & BUFFER_READY) &&
  1601.                         (chanPtr->outQueueHead == (ChannelBuffer *) NULL))) {
  1602.             chanPtr->flags &= (~(BUFFER_READY));
  1603.             chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
  1604.             if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
  1605.                 chanPtr->outQueueHead = chanPtr->curOutPtr;
  1606.             } else {
  1607.                 chanPtr->outQueueTail->nextPtr = chanPtr->curOutPtr;
  1608.             }
  1609.             chanPtr->outQueueTail = chanPtr->curOutPtr;
  1610.             chanPtr->curOutPtr = (ChannelBuffer *) NULL;
  1611.         }
  1612.         bufPtr = chanPtr->outQueueHead;
  1613.  
  1614.         /*
  1615.          * If we are not being called from an async flush and an async
  1616.          * flush is active, we just return without producing any output.
  1617.          */
  1618.  
  1619.         if ((!calledFromAsyncFlush) &&
  1620.                 (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
  1621.             return 0;
  1622.         }
  1623.  
  1624.         /*
  1625.          * If the output queue is still empty, break out of the while loop.
  1626.          */
  1627.  
  1628.         if (bufPtr == (ChannelBuffer *) NULL) {
  1629.             break;    /* Out of the "while (1)". */
  1630.         }
  1631.  
  1632.         /*
  1633.          * Produce the output on the channel.
  1634.          */
  1635.         
  1636.         toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
  1637.         written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
  1638.                 bufPtr->buf + bufPtr->nextRemoved, toWrite, &errorCode);
  1639.             
  1640.     /*
  1641.          * If the write failed completely attempt to start the asynchronous
  1642.          * flush mechanism and break out of this loop - do not attempt to
  1643.          * write any more output at this time.
  1644.          */
  1645.  
  1646.         if (written < 0) {
  1647.             
  1648.             /*
  1649.              * If the last attempt to write was interrupted, simply retry.
  1650.              */
  1651.             
  1652.             if (errorCode == EINTR) {
  1653.                 errorCode = 0;
  1654.                 continue;
  1655.             }
  1656.  
  1657.             /*
  1658.              * If the channel is non-blocking and we would have blocked,
  1659.              * start a background flushing handler and break out of the loop.
  1660.              */
  1661.  
  1662.             if ((errorCode == EWOULDBLOCK) || (errorCode == EAGAIN)) {
  1663.         if (chanPtr->flags & CHANNEL_NONBLOCKING) {
  1664.             if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
  1665.             chanPtr->flags |= BG_FLUSH_SCHEDULED;
  1666.             UpdateInterest(chanPtr);
  1667.                     }
  1668.                     errorCode = 0;
  1669.                     break;
  1670.         } else {
  1671.             panic("Blocking channel driver did not block on output");
  1672.                 }
  1673.             }
  1674.  
  1675.             /*
  1676.              * Decide whether to report the error upwards or defer it.
  1677.              */
  1678.  
  1679.             if (calledFromAsyncFlush) {
  1680.                 if (chanPtr->unreportedError == 0) {
  1681.                     chanPtr->unreportedError = errorCode;
  1682.                 }
  1683.             } else {
  1684.                 Tcl_SetErrno(errorCode);
  1685.         if (interp != NULL) {
  1686.             Tcl_SetResult(interp,
  1687.                 Tcl_PosixError(interp), TCL_VOLATILE);
  1688.         }
  1689.             }
  1690.  
  1691.             /*
  1692.              * When we get an error we throw away all the output
  1693.              * currently queued.
  1694.              */
  1695.  
  1696.             DiscardOutputQueued(chanPtr);
  1697.             continue;
  1698.         }
  1699.  
  1700.         bufPtr->nextRemoved += written;
  1701.  
  1702.         /*
  1703.          * If this buffer is now empty, recycle it.
  1704.          */
  1705.  
  1706.         if (bufPtr->nextRemoved == bufPtr->nextAdded) {
  1707.             chanPtr->outQueueHead = bufPtr->nextPtr;
  1708.             if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
  1709.                 chanPtr->outQueueTail = (ChannelBuffer *) NULL;
  1710.             }
  1711.             RecycleBuffer(chanPtr, bufPtr, 0);
  1712.         }
  1713.     }    /* Closes "while (1)". */
  1714.     
  1715.     /*
  1716.      * If the queue became empty and we have the asynchronous flushing
  1717.      * mechanism active, cancel the asynchronous flushing.
  1718.      */
  1719.  
  1720.     if ((chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
  1721.             (chanPtr->flags & BG_FLUSH_SCHEDULED)) {
  1722.         chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
  1723.     (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
  1724.         chanPtr->interestMask);
  1725.     }
  1726.  
  1727.     /*
  1728.      * If the channel is flagged as closed, delete it when the refCount
  1729.      * drops to zero, the output queue is empty and there is no output
  1730.      * in the current output buffer.
  1731.      */
  1732.  
  1733.     if ((chanPtr->flags & CHANNEL_CLOSED) && (chanPtr->refCount <= 0) &&
  1734.             (chanPtr->outQueueHead == (ChannelBuffer *) NULL) &&
  1735.             ((chanPtr->curOutPtr == (ChannelBuffer *) NULL) ||
  1736.                     (chanPtr->curOutPtr->nextAdded ==
  1737.                             chanPtr->curOutPtr->nextRemoved))) {
  1738.         return CloseChannel(interp, chanPtr, errorCode);
  1739.     }
  1740.     return errorCode;
  1741. }
  1742.  
  1743. /*
  1744.  *----------------------------------------------------------------------
  1745.  *
  1746.  * CloseChannel --
  1747.  *
  1748.  *    Utility procedure to close a channel and free its associated
  1749.  *    resources.
  1750.  *
  1751.  * Results:
  1752.  *    0 on success or a POSIX error code if the operation failed.
  1753.  *
  1754.  * Side effects:
  1755.  *    May close the actual channel; may free memory.
  1756.  *
  1757.  *----------------------------------------------------------------------
  1758.  */
  1759.  
  1760. static int
  1761. CloseChannel(interp, chanPtr, errorCode)
  1762.     Tcl_Interp *interp;            /* For error reporting. */
  1763.     Channel *chanPtr;            /* The channel to close. */
  1764.     int errorCode;            /* Status of operation so far. */
  1765. {
  1766.     int result = 0;            /* Of calling driver close
  1767.                                          * operation. */
  1768.     Channel *prevChanPtr;        /* Preceding channel in list of
  1769.                                          * all channels - used to splice a
  1770.                                          * channel out of the list on close. */
  1771.         
  1772.     if (chanPtr == NULL) {
  1773.         return result;
  1774.     }
  1775.     
  1776.     /*
  1777.      * No more input can be consumed so discard any leftover input.
  1778.      */
  1779.  
  1780.     DiscardInputQueued(chanPtr, 1);
  1781.  
  1782.     /*
  1783.      * Discard a leftover buffer in the current output buffer field.
  1784.      */
  1785.  
  1786.     if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
  1787.         ckfree((char *) chanPtr->curOutPtr);
  1788.         chanPtr->curOutPtr = (ChannelBuffer *) NULL;
  1789.     }
  1790.     
  1791.     /*
  1792.      * The caller guarantees that there are no more buffers
  1793.      * queued for output.
  1794.      */
  1795.  
  1796.     if (chanPtr->outQueueHead != (ChannelBuffer *) NULL) {
  1797.         panic("TclFlush, closed channel: queued output left");
  1798.     }
  1799.  
  1800.     /*
  1801.      * If the EOF character is set in the channel, append that to the
  1802.      * output device.
  1803.      */
  1804.  
  1805.     if ((chanPtr->outEofChar != 0) && (chanPtr->flags & TCL_WRITABLE)) {
  1806.         int dummy;
  1807.         char c;
  1808.  
  1809.         c = (char) chanPtr->outEofChar;
  1810.         (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
  1811.     }
  1812.  
  1813.     /*
  1814.      * Remove TCL_READABLE and TCL_WRITABLE from chanPtr->flags, so
  1815.      * that close callbacks can not do input or output (assuming they
  1816.      * squirreled the channel away in their clientData). This also
  1817.      * prevents infinite loops if the callback calls any C API that
  1818.      * could call FlushChannel.
  1819.      */
  1820.  
  1821.     chanPtr->flags &= (~(TCL_READABLE|TCL_WRITABLE));
  1822.         
  1823.     /*
  1824.      * Splice this channel out of the list of all channels.
  1825.      */
  1826.  
  1827.     if (chanPtr == firstChanPtr) {
  1828.         firstChanPtr = chanPtr->nextChanPtr;
  1829.     } else {
  1830.         for (prevChanPtr = firstChanPtr;
  1831.                  (prevChanPtr != (Channel *) NULL) &&
  1832.                      (prevChanPtr->nextChanPtr != chanPtr);
  1833.                  prevChanPtr = prevChanPtr->nextChanPtr) {
  1834.             /* Empty loop body. */
  1835.         }
  1836.         if (prevChanPtr == (Channel *) NULL) {
  1837.             panic("FlushChannel: damaged channel list");
  1838.         }
  1839.         prevChanPtr->nextChanPtr = chanPtr->nextChanPtr;
  1840.     }
  1841.  
  1842.     /*
  1843.      * OK, close the channel itself.
  1844.      */
  1845.         
  1846.     result = (chanPtr->typePtr->closeProc) (chanPtr->instanceData, interp);
  1847.     
  1848.     if (chanPtr->channelName != (char *) NULL) {
  1849.         ckfree(chanPtr->channelName);
  1850.     }
  1851.     
  1852.     /*
  1853.      * If we are being called synchronously, report either
  1854.      * any latent error on the channel or the current error.
  1855.      */
  1856.         
  1857.     if (chanPtr->unreportedError != 0) {
  1858.         errorCode = chanPtr->unreportedError;
  1859.     }
  1860.     if (errorCode == 0) {
  1861.         errorCode = result;
  1862.         if (errorCode != 0) {
  1863.             Tcl_SetErrno(errorCode);
  1864.         }
  1865.     }
  1866.  
  1867.     /*
  1868.      * Cancel any outstanding timer.
  1869.      */
  1870.  
  1871.     Tcl_DeleteTimerHandler(chanPtr->timer);
  1872.  
  1873.     /*
  1874.      * Mark the channel as deleted by clearing the type structure.
  1875.      */
  1876.  
  1877.     chanPtr->typePtr = NULL;
  1878.  
  1879.     Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
  1880.  
  1881.     return errorCode;
  1882. }
  1883.  
  1884. /*
  1885.  *----------------------------------------------------------------------
  1886.  *
  1887.  * Tcl_Close --
  1888.  *
  1889.  *    Closes a channel.
  1890.  *
  1891.  * Results:
  1892.  *    A standard Tcl result.
  1893.  *
  1894.  * Side effects:
  1895.  *    Closes the channel if this is the last reference.
  1896.  *
  1897.  * NOTE:
  1898.  *    Tcl_Close removes the channel as far as the user is concerned.
  1899.  *    However, it may continue to exist for a while longer if it has
  1900.  *    a background flush scheduled. The device itself is eventually
  1901.  *    closed and the channel record removed, in CloseChannel, above.
  1902.  *
  1903.  *----------------------------------------------------------------------
  1904.  */
  1905.  
  1906.     /* ARGSUSED */
  1907. int
  1908. Tcl_Close(interp, chan)
  1909.     Tcl_Interp *interp;            /* Interpreter for errors. */
  1910.     Tcl_Channel chan;            /* The channel being closed. Must
  1911.                                          * not be referenced in any
  1912.                                          * interpreter. */
  1913. {
  1914.     ChannelHandler *chPtr, *chNext;    /* Iterate over channel handlers. */
  1915.     CloseCallback *cbPtr;        /* Iterate over close callbacks
  1916.                                          * for this channel. */
  1917.     EventScriptRecord *ePtr, *eNextPtr;    /* Iterate over eventscript records. */
  1918.     Channel *chanPtr;            /* The real IO channel. */
  1919.     int result;                /* Of calling FlushChannel. */
  1920.     NextChannelHandler *nhPtr;
  1921.  
  1922.     if (chan == (Tcl_Channel) NULL) {
  1923.         return TCL_OK;
  1924.     }
  1925.     
  1926.     /*
  1927.      * Perform special handling for standard channels being closed. If the
  1928.      * refCount is now 1 it means that the last reference to the standard
  1929.      * channel is being explicitly closed, so bump the refCount down
  1930.      * artificially to 0. This will ensure that the channel is actually
  1931.      * closed, below. Also set the static pointer to NULL for the channel.
  1932.      */
  1933.  
  1934.     CheckForStdChannelsBeingClosed(chan);
  1935.  
  1936.     chanPtr = (Channel *) chan;
  1937.     if (chanPtr->refCount > 0) {
  1938.         panic("called Tcl_Close on channel with refCount > 0");
  1939.     }
  1940.  
  1941.     /*
  1942.      * Remove any references to channel handlers for this channel that
  1943.      * may be about to be invoked.
  1944.      */
  1945.  
  1946.     for (nhPtr = nestedHandlerPtr;
  1947.              nhPtr != (NextChannelHandler *) NULL;
  1948.              nhPtr = nhPtr->nestedHandlerPtr) {
  1949.         if (nhPtr->nextHandlerPtr &&
  1950.         (nhPtr->nextHandlerPtr->chanPtr == chanPtr)) {
  1951.         nhPtr->nextHandlerPtr = NULL;
  1952.         }
  1953.     }
  1954.  
  1955.     /*
  1956.      * Remove all the channel handler records attached to the channel
  1957.      * itself.
  1958.      */
  1959.         
  1960.     for (chPtr = chanPtr->chPtr;
  1961.              chPtr != (ChannelHandler *) NULL;
  1962.              chPtr = chNext) {
  1963.         chNext = chPtr->nextPtr;
  1964.         ckfree((char *) chPtr);
  1965.     }
  1966.     chanPtr->chPtr = (ChannelHandler *) NULL;
  1967.     
  1968.     
  1969.     /*
  1970.      * Cancel any pending copy operation.
  1971.      */
  1972.  
  1973.     StopCopy(chanPtr->csPtr);
  1974.  
  1975.     /*
  1976.      * Must set the interest mask now to 0, otherwise infinite loops
  1977.      * will occur if Tcl_DoOneEvent is called before the channel is
  1978.      * finally deleted in FlushChannel. This can happen if the channel
  1979.      * has a background flush active.
  1980.      */
  1981.         
  1982.     chanPtr->interestMask = 0;
  1983.     
  1984.     /*
  1985.      * Remove any EventScript records for this channel.
  1986.      */
  1987.  
  1988.     for (ePtr = chanPtr->scriptRecordPtr;
  1989.              ePtr != (EventScriptRecord *) NULL;
  1990.              ePtr = eNextPtr) {
  1991.         eNextPtr = ePtr->nextPtr;
  1992.     ckfree(ePtr->script);
  1993.         ckfree((char *) ePtr);
  1994.     }
  1995.     chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
  1996.         
  1997.     /*
  1998.      * Invoke the registered close callbacks and delete their records.
  1999.      */
  2000.  
  2001.     while (chanPtr->closeCbPtr != (CloseCallback *) NULL) {
  2002.         cbPtr = chanPtr->closeCbPtr;
  2003.         chanPtr->closeCbPtr = cbPtr->nextPtr;
  2004.         (cbPtr->proc) (cbPtr->clientData);
  2005.         ckfree((char *) cbPtr);
  2006.     }
  2007.  
  2008.     /*
  2009.      * Ensure that the last output buffer will be flushed.
  2010.      */
  2011.     
  2012.     if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
  2013.            (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
  2014.         chanPtr->flags |= BUFFER_READY;
  2015.     }
  2016.  
  2017.     /*
  2018.      * The call to FlushChannel will flush any queued output and invoke
  2019.      * the close function of the channel driver, or it will set up the
  2020.      * channel to be flushed and closed asynchronously.
  2021.      */
  2022.     
  2023.     chanPtr->flags |= CHANNEL_CLOSED;
  2024.     result = FlushChannel(interp, chanPtr, 0);
  2025.     if (result != 0) {
  2026.         return TCL_ERROR;
  2027.     }
  2028.  
  2029.     return TCL_OK;
  2030. }
  2031.  
  2032. /*
  2033.  *----------------------------------------------------------------------
  2034.  *
  2035.  * Tcl_Write --
  2036.  *
  2037.  *    Puts a sequence of characters into an output buffer, may queue the
  2038.  *    buffer for output if it gets full, and also remembers whether the
  2039.  *    current buffer is ready e.g. if it contains a newline and we are in
  2040.  *    line buffering mode.
  2041.  *
  2042.  * Results:
  2043.  *    The number of bytes written or -1 in case of error. If -1,
  2044.  *    Tcl_GetErrno will return the error code.
  2045.  *
  2046.  * Side effects:
  2047.  *    May buffer up output and may cause output to be produced on the
  2048.  *    channel.
  2049.  *
  2050.  *----------------------------------------------------------------------
  2051.  */
  2052.  
  2053. int
  2054. Tcl_Write(chan, srcPtr, slen)
  2055.     Tcl_Channel chan;            /* The channel to buffer output for. */
  2056.     char *srcPtr;            /* Output to buffer. */
  2057.     int slen;                /* Its length. Negative means
  2058.                                          * the output is null terminated
  2059.                                          * and we must compute its length. */
  2060. {
  2061.     Channel *chanPtr = (Channel *) chan;
  2062.  
  2063.     /*
  2064.      * Check for unreported error.
  2065.      */
  2066.  
  2067.     if (chanPtr->unreportedError != 0) {
  2068.         Tcl_SetErrno(chanPtr->unreportedError);
  2069.         chanPtr->unreportedError = 0;
  2070.         return -1;
  2071.     }
  2072.     
  2073.     /*
  2074.      * If the channel is not open for writing punt.
  2075.      */
  2076.  
  2077.     if (!(chanPtr->flags & TCL_WRITABLE)) {
  2078.         Tcl_SetErrno(EACCES);
  2079.         return -1;
  2080.     }
  2081.     
  2082.     /*
  2083.      * If the channel is in the middle of a background copy, fail.
  2084.      */
  2085.  
  2086.     if (chanPtr->csPtr) {
  2087.     Tcl_SetErrno(EBUSY);
  2088.     return -1;
  2089.     }
  2090.  
  2091.     /*
  2092.      * If length passed is negative, assume that the output is null terminated
  2093.      * and compute its length.
  2094.      */
  2095.     
  2096.     if (slen < 0) {
  2097.         slen = strlen(srcPtr);
  2098.     }
  2099.  
  2100.     return DoWrite(chanPtr, srcPtr, slen);
  2101. }
  2102.  
  2103. /*
  2104.  *----------------------------------------------------------------------
  2105.  *
  2106.  * DoWrite --
  2107.  *
  2108.  *    Puts a sequence of characters into an output buffer, may queue the
  2109.  *    buffer for output if it gets full, and also remembers whether the
  2110.  *    current buffer is ready e.g. if it contains a newline and we are in
  2111.  *    line buffering mode.
  2112.  *
  2113.  * Results:
  2114.  *    The number of bytes written or -1 in case of error. If -1,
  2115.  *    Tcl_GetErrno will return the error code.
  2116.  *
  2117.  * Side effects:
  2118.  *    May buffer up output and may cause output to be produced on the
  2119.  *    channel.
  2120.  *
  2121.  *----------------------------------------------------------------------
  2122.  */
  2123.  
  2124. static int
  2125. DoWrite(chanPtr, srcPtr, slen)
  2126.     Channel *chanPtr;            /* The channel to buffer output for. */
  2127.     char *srcPtr;            /* Data to write. */
  2128.     int slen;                /* Number of bytes to write. */
  2129. {
  2130.     ChannelBuffer *outBufPtr;        /* Current output buffer. */
  2131.     int foundNewline;            /* Did we find a newline in output? */
  2132.     char *dPtr, *sPtr;            /* Search variables for newline. */
  2133.     int crsent;                /* In CRLF eol translation mode,
  2134.                                          * remember the fact that a CR was
  2135.                                          * output to the channel without
  2136.                                          * its following NL. */
  2137.     int i;                /* Loop index for newline search. */
  2138.     int destCopied;            /* How many bytes were used in this
  2139.                                          * destination buffer to hold the
  2140.                                          * output? */
  2141.     int totalDestCopied;        /* How many bytes total were
  2142.                                          * copied to the channel buffer? */
  2143.     int srcCopied;            /* How many bytes were copied from
  2144.                                          * the source string? */
  2145.     char *destPtr;            /* Where in line to copy to? */
  2146.  
  2147.     /*
  2148.      * If we are in network (or windows) translation mode, record the fact
  2149.      * that we have not yet sent a CR to the channel.
  2150.      */
  2151.  
  2152.     crsent = 0;
  2153.     
  2154.     /*
  2155.      * Loop filling buffers and flushing them until all output has been
  2156.      * consumed.
  2157.      */
  2158.  
  2159.     srcCopied = 0;
  2160.     totalDestCopied = 0;
  2161.  
  2162.     while (slen > 0) {
  2163.         
  2164.         /*
  2165.          * Make sure there is a current output buffer to accept output.
  2166.          */
  2167.  
  2168.         if (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
  2169.             chanPtr->curOutPtr = (ChannelBuffer *) ckalloc((unsigned)
  2170.                     (CHANNELBUFFER_HEADER_SIZE + chanPtr->bufSize));
  2171.             chanPtr->curOutPtr->nextAdded = 0;
  2172.             chanPtr->curOutPtr->nextRemoved = 0;
  2173.             chanPtr->curOutPtr->bufSize = chanPtr->bufSize;
  2174.             chanPtr->curOutPtr->nextPtr = (ChannelBuffer *) NULL;
  2175.         }
  2176.  
  2177.         outBufPtr = chanPtr->curOutPtr;
  2178.  
  2179.         destCopied = outBufPtr->bufSize - outBufPtr->nextAdded;
  2180.         if (destCopied > slen) {
  2181.             destCopied = slen;
  2182.         }
  2183.         
  2184.         destPtr = outBufPtr->buf + outBufPtr->nextAdded;
  2185.         switch (chanPtr->outputTranslation) {
  2186.             case TCL_TRANSLATE_LF:
  2187.                 srcCopied = destCopied;
  2188.                 memcpy((VOID *) destPtr, (VOID *) srcPtr, (size_t) destCopied);
  2189.                 break;
  2190.             case TCL_TRANSLATE_CR:
  2191.                 srcCopied = destCopied;
  2192.                 memcpy((VOID *) destPtr, (VOID *) srcPtr, (size_t) destCopied);
  2193.                 for (dPtr = destPtr; dPtr < destPtr + destCopied; dPtr++) {
  2194.                     if (*dPtr == '\n') {
  2195.                         *dPtr = '\r';
  2196.                     }
  2197.                 }
  2198.                 break;
  2199.             case TCL_TRANSLATE_CRLF:
  2200.                 for (srcCopied = 0, dPtr = destPtr, sPtr = srcPtr;
  2201.                      dPtr < destPtr + destCopied;
  2202.                      dPtr++, sPtr++, srcCopied++) {
  2203.                     if (*sPtr == '\n') {
  2204.                         if (crsent) {
  2205.                             *dPtr = '\n';
  2206.                             crsent = 0;
  2207.                         } else {
  2208.                             *dPtr = '\r';
  2209.                             crsent = 1;
  2210.                             sPtr--, srcCopied--;
  2211.                         }
  2212.                     } else {
  2213.                         *dPtr = *sPtr;
  2214.                     }
  2215.                 }
  2216.                 break;
  2217.             case TCL_TRANSLATE_AUTO:
  2218.                 panic("Tcl_Write: AUTO output translation mode not supported");
  2219.             default:
  2220.                 panic("Tcl_Write: unknown output translation mode");
  2221.         }
  2222.  
  2223.         /*
  2224.          * The current buffer is ready for output if it is full, or if it
  2225.          * contains a newline and this channel is line-buffered, or if it
  2226.          * contains any output and this channel is unbuffered.
  2227.          */
  2228.  
  2229.         outBufPtr->nextAdded += destCopied;
  2230.         if (!(chanPtr->flags & BUFFER_READY)) {
  2231.             if (outBufPtr->nextAdded == outBufPtr->bufSize) {
  2232.                 chanPtr->flags |= BUFFER_READY;
  2233.             } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
  2234.                 for (sPtr = srcPtr, i = 0, foundNewline = 0;
  2235.                          (i < srcCopied) && (!foundNewline);
  2236.                          i++, sPtr++) {
  2237.                     if (*sPtr == '\n') {
  2238.                         foundNewline = 1;
  2239.                         break;
  2240.                     }
  2241.                 }
  2242.                 if (foundNewline) {
  2243.                     chanPtr->flags |= BUFFER_READY;
  2244.                 }
  2245.             } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
  2246.                 chanPtr->flags |= BUFFER_READY;
  2247.             }
  2248.         }
  2249.         
  2250.         totalDestCopied += srcCopied;
  2251.         srcPtr += srcCopied;
  2252.         slen -= srcCopied;
  2253.  
  2254.         if (chanPtr->flags & BUFFER_READY) {
  2255.             if (FlushChannel(NULL, chanPtr, 0) != 0) {
  2256.                 return -1;
  2257.             }
  2258.         }
  2259.     } /* Closes "while" */
  2260.  
  2261.     return totalDestCopied;
  2262. }
  2263.  
  2264. /*
  2265.  *----------------------------------------------------------------------
  2266.  *
  2267.  * Tcl_Flush --
  2268.  *
  2269.  *    Flushes output data on a channel.
  2270.  *
  2271.  * Results:
  2272.  *    A standard Tcl result.
  2273.  *
  2274.  * Side effects:
  2275.  *    May flush output queued on this channel.
  2276.  *
  2277.  *----------------------------------------------------------------------
  2278.  */
  2279.  
  2280. int
  2281. Tcl_Flush(chan)
  2282.     Tcl_Channel chan;            /* The Channel to flush. */
  2283. {
  2284.     int result;                /* Of calling FlushChannel. */
  2285.     Channel *chanPtr;            /* The actual channel. */
  2286.  
  2287.     chanPtr = (Channel *) chan;
  2288.  
  2289.     /*
  2290.      * Check for unreported error.
  2291.      */
  2292.  
  2293.     if (chanPtr->unreportedError != 0) {
  2294.         Tcl_SetErrno(chanPtr->unreportedError);
  2295.         chanPtr->unreportedError = 0;
  2296.         return TCL_ERROR;
  2297.     }
  2298.  
  2299.     /*
  2300.      * If the channel is not open for writing punt.
  2301.      */
  2302.  
  2303.     if (!(chanPtr->flags & TCL_WRITABLE)) {
  2304.         Tcl_SetErrno(EACCES);
  2305.         return TCL_ERROR;
  2306.     }
  2307.     
  2308.     /*
  2309.      * If the channel is in the middle of a background copy, fail.
  2310.      */
  2311.  
  2312.     if (chanPtr->csPtr) {
  2313.     Tcl_SetErrno(EBUSY);
  2314.     return -1;
  2315.     }
  2316.  
  2317.     /*
  2318.      * Force current output buffer to be output also.
  2319.      */
  2320.     
  2321.     if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
  2322.             (chanPtr->curOutPtr->nextAdded > 0)) {
  2323.         chanPtr->flags |= BUFFER_READY;
  2324.     }
  2325.     
  2326.     result = FlushChannel(NULL, chanPtr, 0);
  2327.     if (result != 0) {
  2328.         return TCL_ERROR;
  2329.     }
  2330.  
  2331.     return TCL_OK;
  2332. }
  2333.  
  2334. /*
  2335.  *----------------------------------------------------------------------
  2336.  *
  2337.  * DiscardInputQueued --
  2338.  *
  2339.  *    Discards any input read from the channel but not yet consumed
  2340.  *    by Tcl reading commands.
  2341.  *
  2342.  * Results:
  2343.  *    None.
  2344.  *
  2345.  * Side effects:
  2346.  *    May discard input from the channel. If discardLastBuffer is zero,
  2347.  *    leaves one buffer in place for back-filling.
  2348.  *
  2349.  *----------------------------------------------------------------------
  2350.  */
  2351.  
  2352. static void
  2353. DiscardInputQueued(chanPtr, discardSavedBuffers)
  2354.     Channel *chanPtr;        /* Channel on which to discard
  2355.                                  * the queued input. */
  2356.     int discardSavedBuffers;    /* If non-zero, discard all buffers including
  2357.                                  * last one. */
  2358. {
  2359.     ChannelBuffer *bufPtr, *nxtPtr;    /* Loop variables. */
  2360.  
  2361.     bufPtr = chanPtr->inQueueHead;
  2362.     chanPtr->inQueueHead = (ChannelBuffer *) NULL;
  2363.     chanPtr->inQueueTail = (ChannelBuffer *) NULL;
  2364.     for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
  2365.         nxtPtr = bufPtr->nextPtr;
  2366.         RecycleBuffer(chanPtr, bufPtr, discardSavedBuffers);
  2367.     }
  2368.  
  2369.     /*
  2370.      * If discardSavedBuffers is nonzero, must also discard any previously
  2371.      * saved buffer in the saveInBufPtr field.
  2372.      */
  2373.     
  2374.     if (discardSavedBuffers) {
  2375.         if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
  2376.             ckfree((char *) chanPtr->saveInBufPtr);
  2377.             chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
  2378.         }
  2379.     }
  2380. }
  2381.  
  2382. /*
  2383.  *----------------------------------------------------------------------
  2384.  *
  2385.  * GetInput --
  2386.  *
  2387.  *    Reads input data from a device or file into an input buffer.
  2388.  *
  2389.  * Results:
  2390.  *    A Posix error code or 0.
  2391.  *
  2392.  * Side effects:
  2393.  *    Reads from the underlying device.
  2394.  *
  2395.  *----------------------------------------------------------------------
  2396.  */
  2397.  
  2398. static int
  2399. GetInput(chanPtr)
  2400.     Channel *chanPtr;            /* Channel to read input from. */
  2401. {
  2402.     int toRead;                /* How much to read? */
  2403.     int result;                /* Of calling driver. */
  2404.     int nread;                /* How much was read from channel? */
  2405.     ChannelBuffer *bufPtr;        /* New buffer to add to input queue. */
  2406.  
  2407.     /*
  2408.      * Prevent reading from a dead channel -- a channel that has been closed
  2409.      * but not yet deallocated, which can happen if the exit handler for
  2410.      * channel cleanup has run but the channel is still registered in some
  2411.      * interpreter.
  2412.      */
  2413.     
  2414.     if (CheckForDeadChannel(NULL,chanPtr)) return EINVAL;
  2415.  
  2416.     /*
  2417.      * See if we can fill an existing buffer. If we can, read only
  2418.      * as much as will fit in it. Otherwise allocate a new buffer,
  2419.      * add it to the input queue and attempt to fill it to the max.
  2420.      */
  2421.  
  2422.     if ((chanPtr->inQueueTail != (ChannelBuffer *) NULL) &&
  2423.            (chanPtr->inQueueTail->nextAdded < chanPtr->inQueueTail->bufSize)) {
  2424.         bufPtr = chanPtr->inQueueTail;
  2425.         toRead = bufPtr->bufSize - bufPtr->nextAdded;
  2426.     } else {
  2427.     if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
  2428.         bufPtr = chanPtr->saveInBufPtr;
  2429.         chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
  2430.     } else {
  2431.         bufPtr = (ChannelBuffer *) ckalloc(
  2432.         ((unsigned) CHANNELBUFFER_HEADER_SIZE + chanPtr->bufSize));
  2433.         bufPtr->bufSize = chanPtr->bufSize;
  2434.     }
  2435.     bufPtr->nextRemoved = 0;
  2436.     bufPtr->nextAdded = 0;
  2437.         toRead = bufPtr->bufSize;
  2438.         if (chanPtr->inQueueTail == (ChannelBuffer *) NULL) {
  2439.             chanPtr->inQueueHead = bufPtr;
  2440.         } else {
  2441.             chanPtr->inQueueTail->nextPtr = bufPtr;
  2442.         }
  2443.         chanPtr->inQueueTail = bufPtr;
  2444.         bufPtr->nextPtr = (ChannelBuffer *) NULL;
  2445.     }
  2446.       
  2447.     /*
  2448.      * If EOF is set, we should avoid calling the driver because on some
  2449.      * platforms it is impossible to read from a device after EOF.
  2450.      */
  2451.  
  2452.     if (chanPtr->flags & CHANNEL_EOF) {
  2453.     return 0;
  2454.     }
  2455.  
  2456.     nread = (chanPtr->typePtr->inputProc) (chanPtr->instanceData,
  2457.         bufPtr->buf + bufPtr->nextAdded, toRead, &result);
  2458.  
  2459.     if (nread == 0) {
  2460.     chanPtr->flags |= CHANNEL_EOF;
  2461.     } else if (nread < 0) {
  2462.     if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
  2463.         chanPtr->flags |= CHANNEL_BLOCKED;
  2464.         result = EAGAIN;
  2465.         if (chanPtr->flags & CHANNEL_NONBLOCKING) {
  2466.         Tcl_SetErrno(result);
  2467.         } else {
  2468.         panic("Blocking channel driver did not block on input");
  2469.         }
  2470.     } else {
  2471.         Tcl_SetErrno(result);
  2472.     }
  2473.     return result;
  2474.     } else {
  2475.     bufPtr->nextAdded += nread;
  2476.  
  2477.     /*
  2478.      * If we get a short read, signal up that we may be BLOCKED. We
  2479.      * should avoid calling the driver because on some platforms we
  2480.      * will block in the low level reading code even though the
  2481.      * channel is set into nonblocking mode.
  2482.      */
  2483.             
  2484.     if (nread < toRead) {
  2485.         chanPtr->flags |= CHANNEL_BLOCKED;
  2486.     }
  2487.     }
  2488.     return 0;
  2489. }
  2490.  
  2491. /*
  2492.  *----------------------------------------------------------------------
  2493.  *
  2494.  * CopyAndTranslateBuffer --
  2495.  *
  2496.  *    Copy at most one buffer of input to the result space, doing
  2497.  *    eol translations according to mode in effect currently.
  2498.  *
  2499.  * Results:
  2500.  *    Number of characters (as opposed to bytes) copied. May return
  2501.  *    zero if no input is available to be translated.
  2502.  *
  2503.  * Side effects:
  2504.  *    Consumes buffered input. May deallocate one buffer.
  2505.  *
  2506.  *----------------------------------------------------------------------
  2507.  */
  2508.  
  2509. static int
  2510. CopyAndTranslateBuffer(chanPtr, result, space)
  2511.     Channel *chanPtr;        /* The channel from which to read input. */
  2512.     char *result;        /* Where to store the copied input. */
  2513.     int space;            /* How many bytes are available in result
  2514.                                  * to store the copied input? */
  2515. {
  2516.     int bytesInBuffer;        /* How many bytes are available to be
  2517.                                  * copied in the current input buffer? */
  2518.     int copied;            /* How many characters were already copied
  2519.                                  * into the destination space? */
  2520.     ChannelBuffer *bufPtr;    /* The buffer from which to copy bytes. */
  2521.     char curByte;        /* The byte we are currently translating. */
  2522.     int i;            /* Iterates over the copied input looking
  2523.                                  * for the input eofChar. */
  2524.     
  2525.     /*
  2526.      * If there is no input at all, return zero. The invariant is that either
  2527.      * there is no buffer in the queue, or if the first buffer is empty, it
  2528.      * is also the last buffer (and thus there is no input in the queue).
  2529.      * Note also that if the buffer is empty, we leave it in the queue.
  2530.      */
  2531.     
  2532.     if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
  2533.         return 0;
  2534.     }
  2535.     bufPtr = chanPtr->inQueueHead;
  2536.     bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
  2537.     if (bytesInBuffer < space) {
  2538.         space = bytesInBuffer;
  2539.     }
  2540.     copied = 0;
  2541.     switch (chanPtr->inputTranslation) {
  2542.         case TCL_TRANSLATE_LF:
  2543.  
  2544.             if (space == 0) {
  2545.                 return 0;
  2546.             }
  2547.             
  2548.         /*
  2549.              * Copy the current chunk into the result buffer.
  2550.              */
  2551.  
  2552.             memcpy((VOID *) result,
  2553.                     (VOID *)(bufPtr->buf + bufPtr->nextRemoved),
  2554.                     (size_t) space);
  2555.             bufPtr->nextRemoved += space;
  2556.             copied = space;
  2557.             break;
  2558.  
  2559.         case TCL_TRANSLATE_CR:
  2560.  
  2561.             if (space == 0) {
  2562.                 return 0;
  2563.             }
  2564.  
  2565.         /*
  2566.              * Copy the current chunk into the result buffer, then
  2567.              * replace all \r with \n.
  2568.              */
  2569.  
  2570.             memcpy((VOID *) result,
  2571.                     (VOID *)(bufPtr->buf + bufPtr->nextRemoved),
  2572.                     (size_t) space);
  2573.             bufPtr->nextRemoved += space;
  2574.             for (copied = 0; copied < space; copied++) {
  2575.                 if (result[copied] == '\r') {
  2576.                     result[copied] = '\n';
  2577.                 }
  2578.             }
  2579.             break;
  2580.  
  2581.         case TCL_TRANSLATE_CRLF:
  2582.  
  2583.             /*
  2584.              * If there is a held-back "\r" at EOF, produce it now.
  2585.              */
  2586.             
  2587.             if (space == 0) {
  2588.                 if ((chanPtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
  2589.                         (INPUT_SAW_CR | CHANNEL_EOF)) {
  2590.                     result[0] = '\r';
  2591.                     chanPtr->flags &= (~(INPUT_SAW_CR));
  2592.                     return 1;
  2593.                 }
  2594.                 return 0;
  2595.             }
  2596.  
  2597.             /*
  2598.              * Copy the current chunk and replace "\r\n" with "\n"
  2599.              * (but not standalone "\r"!).
  2600.              */
  2601.  
  2602.             for (copied = 0;
  2603.                      (copied < space) &&
  2604.                          (bufPtr->nextRemoved < bufPtr->nextAdded);
  2605.                      copied++) {
  2606.                 curByte = bufPtr->buf[bufPtr->nextRemoved];
  2607.                 bufPtr->nextRemoved++;
  2608.                 if (curByte == '\r') {
  2609.                     if (chanPtr->flags & INPUT_SAW_CR) {
  2610.                         result[copied] = '\r';
  2611.                     } else {
  2612.                         chanPtr->flags |= INPUT_SAW_CR;
  2613.                         copied--;
  2614.                     }
  2615.                 } else if (curByte == '\n') {
  2616.                     chanPtr->flags &= (~(INPUT_SAW_CR));
  2617.                     result[copied] = '\n';
  2618.                 } else {
  2619.                     if (chanPtr->flags & INPUT_SAW_CR) {
  2620.                         chanPtr->flags &= (~(INPUT_SAW_CR));
  2621.                         result[copied] = '\r';
  2622.                         bufPtr->nextRemoved--;
  2623.                     } else {
  2624.                         result[copied] = curByte;
  2625.                     }
  2626.                 }
  2627.             }
  2628.             break;
  2629.                 
  2630.         case TCL_TRANSLATE_AUTO:
  2631.             
  2632.             if (space == 0) {
  2633.                 return 0;
  2634.             }
  2635.  
  2636.             /*
  2637.              * Loop over the current buffer, converting "\r" and "\r\n"
  2638.              * to "\n".
  2639.              */
  2640.  
  2641.             for (copied = 0;
  2642.                      (copied < space) &&
  2643.                          (bufPtr->nextRemoved < bufPtr->nextAdded); ) {
  2644.                 curByte = bufPtr->buf[bufPtr->nextRemoved];
  2645.                 bufPtr->nextRemoved++;
  2646.                 if (curByte == '\r') {
  2647.                     result[copied] = '\n';
  2648.             copied++;
  2649.                     if (bufPtr->nextRemoved < bufPtr->nextAdded) {
  2650.                         if (bufPtr->buf[bufPtr->nextRemoved] == '\n') {
  2651.                             bufPtr->nextRemoved++;
  2652.                         }
  2653.                         chanPtr->flags &= (~(INPUT_SAW_CR));
  2654.                     } else {
  2655.                         chanPtr->flags |= INPUT_SAW_CR;
  2656.                     }
  2657.                 } else {
  2658.                     if (curByte == '\n') {
  2659.                         if (!(chanPtr->flags & INPUT_SAW_CR)) {
  2660.                             result[copied] = '\n';
  2661.                 copied++;
  2662.                         }
  2663.                     } else {
  2664.                         result[copied] = curByte;
  2665.             copied++;
  2666.                     }
  2667.                     chanPtr->flags &= (~(INPUT_SAW_CR));
  2668.                 }
  2669.             }
  2670.             break;
  2671.  
  2672.         default:
  2673.             panic("unknown eol translation mode");
  2674.     }
  2675.  
  2676.     /*
  2677.      * If an in-stream EOF character is set for this channel,, check that
  2678.      * the input we copied so far does not contain the EOF char. If it does,
  2679.      * copy only up to and excluding that character.
  2680.      */
  2681.     
  2682.     if (chanPtr->inEofChar != 0) {
  2683.         for (i = 0; i < copied; i++) {
  2684.             if (result[i] == (char) chanPtr->inEofChar) {
  2685.                 break;
  2686.             }
  2687.         }
  2688.         if (i < copied) {
  2689.  
  2690.             /*
  2691.              * Set sticky EOF so that no further input is presented
  2692.              * to the caller.
  2693.              */
  2694.             
  2695.             chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
  2696.  
  2697.             /*
  2698.              * Reset the start of valid data in the input buffer to the
  2699.              * position of the eofChar, so that subsequent reads will
  2700.              * encounter it immediately. First we set it to the position
  2701.              * of the last byte consumed if all result bytes were the
  2702.              * product of one input byte; since it is possible that "\r\n"
  2703.              * contracted to "\n" in the result, we have to search back
  2704.              * from that position until we find the eofChar, because it
  2705.              * is possible that its actual position in the buffer is n
  2706.              * bytes further back (n is the number of "\r\n" sequences
  2707.              * that were contracted to "\n" in the result).
  2708.              */
  2709.                   
  2710.             bufPtr->nextRemoved -= (copied - i);
  2711.             while ((bufPtr->nextRemoved > 0) &&
  2712.                     (bufPtr->buf[bufPtr->nextRemoved] !=
  2713.                             (char) chanPtr->inEofChar)) {
  2714.                 bufPtr->nextRemoved--;
  2715.             }
  2716.             copied = i;
  2717.         }
  2718.     }
  2719.  
  2720.     /*
  2721.      * If the current buffer is empty recycle it.
  2722.      */
  2723.  
  2724.     if (bufPtr->nextRemoved == bufPtr->nextAdded) {
  2725.         chanPtr->inQueueHead = bufPtr->nextPtr;
  2726.         if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
  2727.             chanPtr->inQueueTail = (ChannelBuffer *) NULL;
  2728.         }
  2729.         RecycleBuffer(chanPtr, bufPtr, 0);
  2730.     }
  2731.  
  2732.     /*
  2733.      * Return the number of characters copied into the result buffer.
  2734.      * This may be different from the number of bytes consumed, because
  2735.      * of EOL translations.
  2736.      */
  2737.  
  2738.     return copied;
  2739. }
  2740.  
  2741. /*
  2742.  *----------------------------------------------------------------------
  2743.  *
  2744.  * ScanBufferForEOL --
  2745.  *
  2746.  *    Scans one buffer for EOL according to the specified EOL
  2747.  *    translation mode. If it sees the input eofChar for the channel
  2748.  *    it stops also.
  2749.  *
  2750.  * Results:
  2751.  *    TRUE if EOL is found, FALSE otherwise. Also sets output parameter
  2752.  *    bytesToEOLPtr to the number of bytes so far to EOL, and crSeenPtr
  2753.  *    to whether a "\r" was seen.
  2754.  *
  2755.  * Side effects:
  2756.  *    None.
  2757.  *
  2758.  *----------------------------------------------------------------------
  2759.  */
  2760.  
  2761. static int
  2762. ScanBufferForEOL(chanPtr, bufPtr, translation, eofChar, bytesToEOLPtr,
  2763.                  crSeenPtr)
  2764.     Channel *chanPtr;
  2765.     ChannelBuffer *bufPtr;        /* Buffer to scan for EOL. */
  2766.     Tcl_EolTranslation translation;    /* Translation mode to use. */
  2767.     int eofChar;            /* EOF char to look for. */
  2768.     int *bytesToEOLPtr;            /* Running counter. */
  2769.     int *crSeenPtr;            /* Has "\r" been seen? */
  2770. {
  2771.     char *rPtr;                /* Iterates over input string. */
  2772.     char *sPtr;                /* Where to stop search? */
  2773.     int EOLFound;
  2774.     int bytesToEOL;
  2775.     
  2776.     for (EOLFound = 0, rPtr = bufPtr->buf + bufPtr->nextRemoved,
  2777.              sPtr = bufPtr->buf + bufPtr->nextAdded,
  2778.              bytesToEOL = *bytesToEOLPtr;
  2779.              (!EOLFound) && (rPtr < sPtr);
  2780.              rPtr++) {
  2781.         switch (translation) {
  2782.             case TCL_TRANSLATE_AUTO:
  2783.                 if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
  2784.                     chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
  2785.                     EOLFound = 1;
  2786.                 } else if (*rPtr == '\n') {
  2787.  
  2788.             /*
  2789.                      * CopyAndTranslateBuffer wants to know the length
  2790.                      * of the result, not the input. The input is one
  2791.                      * larger because "\r\n" shrinks to "\n".
  2792.                      */
  2793.  
  2794.                     if (!(*crSeenPtr)) {
  2795.                         bytesToEOL++;
  2796.             EOLFound = 1;
  2797.                     } else {
  2798.  
  2799.             /*
  2800.              * This is a lf at the begining of a buffer
  2801.              * where the previous buffer ended in a cr.
  2802.              * Consume this lf because we've already emitted
  2803.              * the newline for this crlf sequence. ALSO, if
  2804.                          * bytesToEOL is 0 (which means that we are at the
  2805.                          * first character of the scan), unset the
  2806.                          * INPUT_SAW_CR flag in the channel, because we
  2807.                          * already handled it; leaving it set would cause
  2808.                          * CopyAndTranslateBuffer to potentially consume
  2809.                          * another lf if one follows the current byte.
  2810.              */
  2811.  
  2812.             bufPtr->nextRemoved++;
  2813.                         *crSeenPtr = 0;
  2814.                         chanPtr->flags &= (~(INPUT_SAW_CR));
  2815.             }
  2816.                 } else if (*rPtr == '\r') {
  2817.                     bytesToEOL++;
  2818.                     EOLFound = 1;
  2819.                 } else {
  2820.                     *crSeenPtr = 0;
  2821.                     bytesToEOL++;
  2822.                 }
  2823.                 break;
  2824.             case TCL_TRANSLATE_LF:
  2825.                 if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
  2826.                     chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
  2827.                     EOLFound = 1;
  2828.                 } else {
  2829.                     if (*rPtr == '\n') {
  2830.                         EOLFound = 1;
  2831.                     }
  2832.                     bytesToEOL++;
  2833.                 }
  2834.                 break;
  2835.             case TCL_TRANSLATE_CR:
  2836.                 if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
  2837.                     chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
  2838.                     EOLFound = 1;
  2839.                 } else {
  2840.                     if (*rPtr == '\r') {
  2841.                         EOLFound = 1;
  2842.                     }
  2843.                     bytesToEOL++;
  2844.                 }
  2845.                 break;
  2846.             case TCL_TRANSLATE_CRLF:
  2847.                 if ((*rPtr == (char) eofChar) && (eofChar != 0)) {
  2848.                     chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
  2849.                     EOLFound = 1;
  2850.                 } else if (*rPtr == '\n') {
  2851.  
  2852.                     /*
  2853.                      * CopyAndTranslateBuffer wants to know the length
  2854.                      * of the result, not the input. The input is one
  2855.                      * larger because crlf shrinks to lf.
  2856.                      */
  2857.  
  2858.                     if (*crSeenPtr) {
  2859.                         EOLFound = 1;
  2860.                     } else {
  2861.                         bytesToEOL++;
  2862.                     }
  2863.                 } else {
  2864.                     if (*rPtr == '\r') {
  2865.                         *crSeenPtr = 1;
  2866.                     } else {
  2867.                         *crSeenPtr = 0;
  2868.                     }
  2869.                     bytesToEOL++;
  2870.                 }
  2871.                 break;
  2872.             default:
  2873.                 panic("unknown eol translation mode");
  2874.         }
  2875.     }
  2876.  
  2877.     *bytesToEOLPtr = bytesToEOL;
  2878.     return EOLFound;
  2879. }
  2880.  
  2881. /*
  2882.  *----------------------------------------------------------------------
  2883.  *
  2884.  * ScanInputForEOL --
  2885.  *
  2886.  *    Scans queued input for chanPtr for an end of line (according to the
  2887.  *    current EOL translation mode) and returns the number of bytes
  2888.  *    upto and including the end of line, or -1 if none was found.
  2889.  *
  2890.  * Results:
  2891.  *    Count of bytes upto and including the end of line if one is present
  2892.  *    or -1 if none was found. Also returns in an output parameter the
  2893.  *    number of bytes queued if no end of line was found.
  2894.  *
  2895.  * Side effects:
  2896.  *    None.
  2897.  *
  2898.  *----------------------------------------------------------------------
  2899.  */
  2900.  
  2901. static int
  2902. ScanInputForEOL(chanPtr, bytesQueuedPtr)
  2903.     Channel *chanPtr;    /* Channel for which to scan queued
  2904.                                  * input for end of line. */
  2905.     int *bytesQueuedPtr;    /* Where to store the number of bytes
  2906.                                  * currently queued if no end of line
  2907.                                  * was found. */
  2908. {
  2909.     ChannelBuffer *bufPtr;    /* Iterates over queued buffers. */
  2910.     int bytesToEOL;        /* How many bytes to end of line? */
  2911.     int EOLFound;        /* Did we find an end of line? */
  2912.     int crSeen;            /* Did we see a "\r" in CRLF mode? */
  2913.  
  2914.     *bytesQueuedPtr = 0;
  2915.     bytesToEOL = 0;
  2916.     EOLFound = 0;
  2917.     for (bufPtr = chanPtr->inQueueHead,
  2918.              crSeen = (chanPtr->flags & INPUT_SAW_CR) ? 1 : 0;
  2919.             (!EOLFound) && (bufPtr != (ChannelBuffer *) NULL);
  2920.             bufPtr = bufPtr->nextPtr) {
  2921.         EOLFound = ScanBufferForEOL(chanPtr, bufPtr, chanPtr->inputTranslation,
  2922.                 chanPtr->inEofChar, &bytesToEOL, &crSeen);
  2923.     }
  2924.  
  2925.     if (EOLFound == 0) {
  2926.         *bytesQueuedPtr = bytesToEOL;
  2927.         return -1;
  2928.     }
  2929.     return bytesToEOL;        
  2930. }
  2931.  
  2932. /*
  2933.  *----------------------------------------------------------------------
  2934.  *
  2935.  * GetEOL --
  2936.  *
  2937.  *    Accumulate input into the channel input buffer queue until an
  2938.  *    end of line has been seen.
  2939.  *
  2940.  * Results:
  2941.  *    Number of bytes buffered (at least 1) or -1 on failure.
  2942.  *
  2943.  * Side effects:
  2944.  *    Consumes input from the channel.
  2945.  *
  2946.  *----------------------------------------------------------------------
  2947.  */
  2948.  
  2949. static int
  2950. GetEOL(chanPtr)
  2951.     Channel *chanPtr;    /* Channel to queue input on. */
  2952. {
  2953.     int bytesToEOL;        /* How many bytes in buffer up to and
  2954.                                  * including the end of line? */
  2955.     int bytesQueued;        /* How many bytes are queued currently
  2956.                                  * in the input chain of the channel? */
  2957.  
  2958.     /*
  2959.      * Check for unreported error.
  2960.      */
  2961.  
  2962.     if (chanPtr->unreportedError != 0) {
  2963.         Tcl_SetErrno(chanPtr->unreportedError);
  2964.         chanPtr->unreportedError = 0;
  2965.         return -1;
  2966.     }
  2967.  
  2968.     /*
  2969.      * Punt if the channel is not opened for reading.
  2970.      */
  2971.  
  2972.     if (!(chanPtr->flags & TCL_READABLE)) {
  2973.         Tcl_SetErrno(EACCES);
  2974.         return -1;
  2975.     }
  2976.  
  2977.     /*
  2978.      * If the channel is in the middle of a background copy, fail.
  2979.      */
  2980.  
  2981.     if (chanPtr->csPtr) {
  2982.     Tcl_SetErrno(EBUSY);
  2983.     return -1;
  2984.     }
  2985.  
  2986.     /*
  2987.      * If we have not encountered a sticky EOF, clear the EOF bit
  2988.      * (sticky EOF is set if we have seen the input eofChar, to prevent
  2989.      * reading beyond the eofChar). Also, always clear the BLOCKED bit.
  2990.      * We want to discover these conditions anew in each operation.
  2991.      */
  2992.     
  2993.     if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
  2994.         chanPtr->flags &= (~(CHANNEL_EOF));
  2995.     }
  2996.     chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_GETS_BLOCKED));
  2997.  
  2998.     while (1) {
  2999.         bytesToEOL = ScanInputForEOL(chanPtr, &bytesQueued);
  3000.         if (bytesToEOL > 0) {
  3001.             chanPtr->flags &= (~(CHANNEL_BLOCKED));
  3002.             return bytesToEOL;
  3003.         }
  3004.         if (chanPtr->flags & CHANNEL_EOF) {
  3005.         /*
  3006.          * Boundary case where cr was at the end of the previous buffer
  3007.          * and this buffer just has a newline.  At EOF our caller wants
  3008.          * to see -1 for the line length.
  3009.          */
  3010.             return (bytesQueued == 0) ? -1 : bytesQueued ;
  3011.         }
  3012.         if (chanPtr->flags & CHANNEL_BLOCKED) {
  3013.             if (chanPtr->flags & CHANNEL_NONBLOCKING) {
  3014.         goto blocked;
  3015.             }
  3016.             chanPtr->flags &= (~(CHANNEL_BLOCKED));
  3017.         }
  3018.     if (GetInput(chanPtr) != 0) {
  3019.         goto blocked;
  3020.         }
  3021.     }
  3022.  
  3023.     blocked:
  3024.  
  3025.     /*
  3026.      * We didn't get a complete line so we need to indicate to UpdateInterest
  3027.      * that the gets blocked.  It will wait for more data instead of firing
  3028.      * a timer, avoiding a busy wait.  This is where we are assuming that the
  3029.      * next operation is a gets.  No more file events will be delivered on 
  3030.      * this channel until new data arrives or some operation is performed
  3031.      * on the channel (e.g. gets, read, fconfigure) that changes the blocking
  3032.      * state.  Note that this means a file event will not be delivered even
  3033.      * though a read would be able to consume the buffered data.
  3034.      */
  3035.  
  3036.     chanPtr->flags |= CHANNEL_GETS_BLOCKED;
  3037.     return -1;
  3038. }
  3039.  
  3040. /*
  3041.  *----------------------------------------------------------------------
  3042.  *
  3043.  * Tcl_Read --
  3044.  *
  3045.  *    Reads a given number of characters from a channel.
  3046.  *
  3047.  * Results:
  3048.  *    The number of characters read, or -1 on error. Use Tcl_GetErrno()
  3049.  *    to retrieve the error code for the error that occurred.
  3050.  *
  3051.  * Side effects:
  3052.  *    May cause input to be buffered.
  3053.  *
  3054.  *----------------------------------------------------------------------
  3055.  */
  3056.  
  3057. int
  3058. Tcl_Read(chan, bufPtr, toRead)
  3059.     Tcl_Channel chan;        /* The channel from which to read. */
  3060.     char *bufPtr;        /* Where to store input read. */
  3061.     int toRead;            /* Maximum number of characters to read. */
  3062. {
  3063.     Channel *chanPtr;        /* The real IO channel. */
  3064.     
  3065.     chanPtr = (Channel *) chan;
  3066.  
  3067.     /*
  3068.      * Check for unreported error.
  3069.      */
  3070.  
  3071.     if (chanPtr->unreportedError != 0) {
  3072.         Tcl_SetErrno(chanPtr->unreportedError);
  3073.         chanPtr->unreportedError = 0;
  3074.         return -1;
  3075.     }
  3076.  
  3077.     /*
  3078.      * Punt if the channel is not opened for reading.
  3079.      */
  3080.  
  3081.     if (!(chanPtr->flags & TCL_READABLE)) {
  3082.         Tcl_SetErrno(EACCES);
  3083.         return -1;
  3084.     }
  3085.     
  3086.     /*
  3087.      * If the channel is in the middle of a background copy, fail.
  3088.      */
  3089.  
  3090.     if (chanPtr->csPtr) {
  3091.     Tcl_SetErrno(EBUSY);
  3092.     return -1;
  3093.     }
  3094.  
  3095.     return DoRead(chanPtr, bufPtr, toRead);
  3096. }
  3097.  
  3098. /*
  3099.  *----------------------------------------------------------------------
  3100.  *
  3101.  * DoRead --
  3102.  *
  3103.  *    Reads a given number of characters from a channel.
  3104.  *
  3105.  * Results:
  3106.  *    The number of characters read, or -1 on error. Use Tcl_GetErrno()
  3107.  *    to retrieve the error code for the error that occurred.
  3108.  *
  3109.  * Side effects:
  3110.  *    May cause input to be buffered.
  3111.  *
  3112.  *----------------------------------------------------------------------
  3113.  */
  3114.  
  3115. static int
  3116. DoRead(chanPtr, bufPtr, toRead)
  3117.     Channel *chanPtr;        /* The channel from which to read. */
  3118.     char *bufPtr;        /* Where to store input read. */
  3119.     int toRead;            /* Maximum number of characters to read. */
  3120. {
  3121.     int copied;            /* How many characters were copied into
  3122.                                  * the result string? */
  3123.     int copiedNow;        /* How many characters were copied from
  3124.                                  * the current input buffer? */
  3125.     int result;            /* Of calling GetInput. */
  3126.     
  3127.     /*
  3128.      * If we have not encountered a sticky EOF, clear the EOF bit. Either
  3129.      * way clear the BLOCKED bit. We want to discover these anew during
  3130.      * each operation.
  3131.      */
  3132.  
  3133.     if (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
  3134.         chanPtr->flags &= (~(CHANNEL_EOF));
  3135.     }
  3136.     chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_GETS_BLOCKED));
  3137.     
  3138.     for (copied = 0; copied < toRead; copied += copiedNow) {
  3139.         copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,
  3140.                 toRead - copied);
  3141.         if (copiedNow == 0) {
  3142.             if (chanPtr->flags & CHANNEL_EOF) {
  3143.                 return copied;
  3144.             }
  3145.             if (chanPtr->flags & CHANNEL_BLOCKED) {
  3146.                 if (chanPtr->flags & CHANNEL_NONBLOCKING) {
  3147.                     return copied;
  3148.                 }
  3149.                 chanPtr->flags &= (~(CHANNEL_BLOCKED));
  3150.             }
  3151.             result = GetInput(chanPtr);
  3152.             if (result != 0) {
  3153.                 if (result == EAGAIN) {
  3154.                     return copied;
  3155.                 }
  3156.                 return -1;
  3157.             }
  3158.         }
  3159.     }
  3160.     chanPtr->flags &= (~(CHANNEL_BLOCKED));
  3161.     return copied;
  3162. }
  3163.  
  3164. /*
  3165.  *----------------------------------------------------------------------
  3166.  *
  3167.  * Tcl_Gets --
  3168.  *
  3169.  *    Reads a complete line of input from the channel into a
  3170.  *    Tcl_DString.
  3171.  *
  3172.  * Results:
  3173.  *    Length of line read or -1 if error, EOF or blocked. If -1, use
  3174.  *    Tcl_GetErrno() to retrieve the POSIX error code for the
  3175.  *    error or condition that occurred.
  3176.  *
  3177.  * Side effects:
  3178.  *    May flush output on the channel. May cause input to be
  3179.  *    consumed from the channel.
  3180.  *
  3181.  *----------------------------------------------------------------------
  3182.  */
  3183.  
  3184. int
  3185. Tcl_Gets(chan, lineRead)
  3186.     Tcl_Channel chan;        /* Channel from which to read. */
  3187.     Tcl_DString *lineRead;    /* The characters of the line read
  3188.                                  * (excluding the terminating newline if
  3189.                                  * present) will be appended to this
  3190.                                  * DString. The caller must have initialized
  3191.                                  * it and is responsible for managing the
  3192.                                  * storage. */
  3193. {
  3194.     Channel *chanPtr;        /* The channel to read from. */
  3195.     char *buf;            /* Points into DString where data
  3196.                                  * will be stored. */
  3197.     int offset;            /* Offset from start of DString at
  3198.                                  * which to append the line just read. */
  3199.     int copiedTotal;        /* Accumulates total length of input copied. */
  3200.     int copiedNow;        /* How many bytes were copied from the
  3201.                                  * current input buffer? */
  3202.     int lineLen;        /* Length of line read, including the
  3203.                                  * translated newline. If this is zero
  3204.                                  * and neither EOF nor BLOCKED is set,
  3205.                                  * the current line is empty. */
  3206.     
  3207.     chanPtr = (Channel *) chan;
  3208.  
  3209.     lineLen = GetEOL(chanPtr);
  3210.     if (lineLen < 0) {
  3211.         return -1;
  3212.     }
  3213.     offset = Tcl_DStringLength(lineRead);
  3214.     Tcl_DStringSetLength(lineRead, lineLen + offset);
  3215.     buf = Tcl_DStringValue(lineRead) + offset;
  3216.  
  3217.     for (copiedTotal = 0; copiedTotal < lineLen; copiedTotal += copiedNow) {
  3218.         copiedNow = CopyAndTranslateBuffer(chanPtr, buf + copiedTotal,
  3219.                 lineLen - copiedTotal);
  3220.     }
  3221.     if ((copiedTotal > 0) && (buf[copiedTotal - 1] == '\n')) {
  3222.         copiedTotal--;
  3223.     }
  3224.     Tcl_DStringSetLength(lineRead, copiedTotal + offset);
  3225.     return copiedTotal;
  3226. }
  3227.  
  3228. /*
  3229.  *----------------------------------------------------------------------
  3230.  *
  3231.  * Tcl_GetsObj --
  3232.  *
  3233.  *    Reads a complete line of input from the channel into a
  3234.  *    string object.
  3235.  *
  3236.  * Results:
  3237.  *    Length of line read or -1 if error, EOF or blocked. If -1, use
  3238.  *    Tcl_GetErrno() to retrieve the POSIX error code for the
  3239.  *    error or condition that occurred.
  3240.  *
  3241.  * Side effects:
  3242.  *    May flush output on the channel. May cause input to be
  3243.  *    consumed from the channel.
  3244.  *
  3245.  *----------------------------------------------------------------------
  3246.  */
  3247.  
  3248. int
  3249. Tcl_GetsObj(chan, objPtr)
  3250.     Tcl_Channel chan;        /* Channel from which to read. */
  3251.     Tcl_Obj *objPtr;        /* The characters of the line read
  3252.                                  * (excluding the terminating newline if
  3253.                                  * present) will be appended to this
  3254.                                  * object. The caller must have initialized
  3255.                                  * it and is responsible for managing the
  3256.                                  * storage. */
  3257. {
  3258.     Channel *chanPtr;        /* The channel to read from. */
  3259.     char *buf;            /* Points into DString where data
  3260.                                  * will be stored. */
  3261.     int offset;            /* Offset from start of DString at
  3262.                                  * which to append the line just read. */
  3263.     int copiedTotal;        /* Accumulates total length of input copied. */
  3264.     int copiedNow;        /* How many bytes were copied from the
  3265.                                  * current input buffer? */
  3266.     int lineLen;        /* Length of line read, including the
  3267.                                  * translated newline. If this is zero
  3268.                                  * and neither EOF nor BLOCKED is set,
  3269.                                  * the current line is empty. */
  3270.     
  3271.     chanPtr = (Channel *) chan;
  3272.  
  3273.     lineLen = GetEOL(chanPtr);
  3274.     if (lineLen < 0) {
  3275.         return -1;
  3276.     }
  3277.     (void) Tcl_GetStringFromObj(objPtr, &offset);
  3278.     Tcl_SetObjLength(objPtr, lineLen + offset);
  3279.     buf = Tcl_GetStringFromObj(objPtr, NULL) + offset;
  3280.  
  3281.     for (copiedTotal = 0; copiedTotal < lineLen; copiedTotal += copiedNow) {
  3282.         copiedNow = CopyAndTranslateBuffer(chanPtr, buf + copiedTotal,
  3283.                 lineLen - copiedTotal);
  3284.     }
  3285.     if ((copiedTotal > 0) && (buf[copiedTotal - 1] == '\n')) {
  3286.         copiedTotal--;
  3287.     }
  3288.     Tcl_SetObjLength(objPtr, copiedTotal + offset);
  3289.     return copiedTotal;
  3290. }
  3291.  
  3292. /*
  3293.  *----------------------------------------------------------------------
  3294.  *
  3295.  * Tcl_Ungets --
  3296.  *
  3297.  *    Causes the supplied string to be added to the input queue of
  3298.  *    the channel, at either the head or tail of the queue.
  3299.  *
  3300.  * Results:
  3301.  *    The number of bytes stored in the channel, or -1 on error.
  3302.  *
  3303.  * Side effects:
  3304.  *    Adds input to the input queue of a channel.
  3305.  *
  3306.  *----------------------------------------------------------------------
  3307.  */
  3308.  
  3309. int
  3310. Tcl_Ungets(chan, str, len, atEnd)
  3311.     Tcl_Channel chan;        /* The channel for which to add the input. */
  3312.     char *str;            /* The input itself. */
  3313.     int len;            /* The length of the input. */
  3314.     int atEnd;            /* If non-zero, add at end of queue; otherwise
  3315.                                  * add at head of queue. */    
  3316. {
  3317.     Channel *chanPtr;        /* The real IO channel. */
  3318.     ChannelBuffer *bufPtr;    /* Buffer to contain the data. */
  3319.     int i;
  3320.  
  3321.     chanPtr = (Channel *) chan;
  3322.  
  3323.     /*
  3324.      * Check for unreported error.
  3325.      */
  3326.  
  3327.     if (chanPtr->unreportedError != 0) {
  3328.         Tcl_SetErrno(chanPtr->unreportedError);
  3329.         chanPtr->unreportedError = 0;
  3330.         return -1;
  3331.     }
  3332.  
  3333.     /*
  3334.      * Punt if the channel is not opened for reading.
  3335.      */
  3336.  
  3337.     if (!(chanPtr->flags & TCL_READABLE)) {
  3338.         Tcl_SetErrno(EACCES);
  3339.         return -1;
  3340.     }
  3341.  
  3342.     /*
  3343.      * If the channel is in the middle of a background copy, fail.
  3344.      */
  3345.  
  3346.     if (chanPtr->csPtr) {
  3347.     Tcl_SetErrno(EBUSY);
  3348.     return -1;
  3349.     }
  3350.  
  3351.     /*
  3352.      * If we have encountered a sticky EOF, just punt without storing.
  3353.      * (sticky EOF is set if we have seen the input eofChar, to prevent
  3354.      * reading beyond the eofChar). Otherwise, clear the EOF flags, and
  3355.      * clear the BLOCKED bit. We want to discover these conditions anew
  3356.      * in each operation.
  3357.      */
  3358.  
  3359.     if (chanPtr->flags & CHANNEL_STICKY_EOF) {
  3360.         return len;
  3361.     }
  3362.     chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
  3363.  
  3364.     bufPtr = (ChannelBuffer *) ckalloc((unsigned)
  3365.             (CHANNELBUFFER_HEADER_SIZE + len));
  3366.     for (i = 0; i < len; i++) {
  3367.         bufPtr->buf[i] = str[i];
  3368.     }
  3369.     bufPtr->bufSize = len;
  3370.     bufPtr->nextAdded = len;
  3371.     bufPtr->nextRemoved = 0;
  3372.  
  3373.     if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
  3374.         bufPtr->nextPtr = (ChannelBuffer *) NULL;
  3375.         chanPtr->inQueueHead = bufPtr;
  3376.         chanPtr->inQueueTail = bufPtr;
  3377.     } else if (atEnd) {
  3378.         bufPtr->nextPtr = (ChannelBuffer *) NULL;
  3379.         chanPtr->inQueueTail->nextPtr = bufPtr;
  3380.         chanPtr->inQueueTail = bufPtr;
  3381.     } else {
  3382.         bufPtr->nextPtr = chanPtr->inQueueHead;
  3383.         chanPtr->inQueueHead = bufPtr;
  3384.     }
  3385.  
  3386.     return len;
  3387. }
  3388.  
  3389. /*
  3390.  *----------------------------------------------------------------------
  3391.  *
  3392.  * Tcl_Seek --
  3393.  *
  3394.  *    Implements seeking on Tcl Channels. This is a public function
  3395.  *    so that other C facilities may be implemented on top of it.
  3396.  *
  3397.  * Results:
  3398.  *    The new access point or -1 on error. If error, use Tcl_GetErrno()
  3399.  *    to retrieve the POSIX error code for the error that occurred.
  3400.  *
  3401.  * Side effects:
  3402.  *    May flush output on the channel. May discard queued input.
  3403.  *
  3404.  *----------------------------------------------------------------------
  3405.  */
  3406.  
  3407. int
  3408. Tcl_Seek(chan, offset, mode)
  3409.     Tcl_Channel chan;        /* The channel on which to seek. */
  3410.     int offset;            /* Offset to seek to. */
  3411.     int mode;            /* Relative to which location to seek? */
  3412. {
  3413.     Channel *chanPtr;        /* The real IO channel. */
  3414.     ChannelBuffer *bufPtr;
  3415.     int inputBuffered, outputBuffered;
  3416.     int result;            /* Of device driver operations. */
  3417.     int curPos;            /* Position on the device. */
  3418.     int wasAsync;        /* Was the channel nonblocking before the
  3419.                                  * seek operation? If so, must restore to
  3420.                                  * nonblocking mode after the seek. */
  3421.  
  3422.     chanPtr = (Channel *) chan;
  3423.  
  3424.     /*
  3425.      * Check for unreported error.
  3426.      */
  3427.  
  3428.     if (chanPtr->unreportedError != 0) {
  3429.         Tcl_SetErrno(chanPtr->unreportedError);
  3430.         chanPtr->unreportedError = 0;
  3431.         return -1;
  3432.     }
  3433.  
  3434.     /*
  3435.      * Disallow seek on channels that are open for neither writing nor
  3436.      * reading (e.g. socket server channels).
  3437.      */
  3438.  
  3439.     if (!(chanPtr->flags & (TCL_WRITABLE|TCL_READABLE))) {
  3440.         Tcl_SetErrno(EACCES);
  3441.         return -1;
  3442.     }
  3443.  
  3444.     /*
  3445.      * If the channel is in the middle of a background copy, fail.
  3446.      */
  3447.  
  3448.     if (chanPtr->csPtr) {
  3449.     Tcl_SetErrno(EBUSY);
  3450.     return -1;
  3451.     }
  3452.  
  3453.     /*
  3454.      * Disallow seek on dead channels -- channels that have been closed but
  3455.      * not yet been deallocated. Such channels can be found if the exit
  3456.      * handler for channel cleanup has run but the channel is still
  3457.      * registered in an interpreter.
  3458.      */
  3459.  
  3460.     if (CheckForDeadChannel(NULL,chanPtr)) return -1;
  3461.  
  3462.     /*
  3463.      * Disallow seek on channels whose type does not have a seek procedure
  3464.      * defined. This means that the channel does not support seeking.
  3465.      */
  3466.  
  3467.     if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
  3468.         Tcl_SetErrno(EINVAL);
  3469.         return -1;
  3470.     }
  3471.  
  3472.     /*
  3473.      * Compute how much input and output is buffered. If both input and
  3474.      * output is buffered, cannot compute the current position.
  3475.      */
  3476.  
  3477.     for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
  3478.              bufPtr != (ChannelBuffer *) NULL;
  3479.              bufPtr = bufPtr->nextPtr) {
  3480.         inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
  3481.     }
  3482.     for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
  3483.              bufPtr != (ChannelBuffer *) NULL;
  3484.              bufPtr = bufPtr->nextPtr) {
  3485.         outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
  3486.     }
  3487.     if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
  3488.            (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
  3489.         chanPtr->flags |= BUFFER_READY;
  3490.         outputBuffered +=
  3491.             (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
  3492.     }
  3493.  
  3494.     if ((inputBuffered != 0) && (outputBuffered != 0)) {
  3495.         Tcl_SetErrno(EFAULT);
  3496.         return -1;
  3497.     }
  3498.  
  3499.     /*
  3500.      * If we are seeking relative to the current position, compute the
  3501.      * corrected offset taking into account the amount of unread input.
  3502.      */
  3503.  
  3504.     if (mode == SEEK_CUR) {
  3505.         offset -= inputBuffered;
  3506.     }
  3507.  
  3508.     /*
  3509.      * Discard any queued input - this input should not be read after
  3510.      * the seek.
  3511.      */
  3512.  
  3513.     DiscardInputQueued(chanPtr, 0);
  3514.  
  3515.     /*
  3516.      * Reset EOF and BLOCKED flags. We invalidate them by moving the
  3517.      * access point. Also clear CR related flags.
  3518.      */
  3519.  
  3520.     chanPtr->flags &=
  3521.         (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR));
  3522.     
  3523.     /*
  3524.      * If the channel is in asynchronous output mode, switch it back
  3525.      * to synchronous mode and cancel any async flush that may be
  3526.      * scheduled. After the flush, the channel will be put back into
  3527.      * asynchronous output mode.
  3528.      */
  3529.  
  3530.     wasAsync = 0;
  3531.     if (chanPtr->flags & CHANNEL_NONBLOCKING) {
  3532.         wasAsync = 1;
  3533.         result = 0;
  3534.         if (chanPtr->typePtr->blockModeProc != NULL) {
  3535.             result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
  3536.                     TCL_MODE_BLOCKING);
  3537.         }
  3538.         if (result != 0) {
  3539.             Tcl_SetErrno(result);
  3540.             return -1;
  3541.         }
  3542.         chanPtr->flags &= (~(CHANNEL_NONBLOCKING));
  3543.         if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
  3544.             chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
  3545.         }
  3546.     }
  3547.     
  3548.     /*
  3549.      * If the flush fails we cannot recover the original position. In
  3550.      * that case the seek is not attempted because we do not know where
  3551.      * the access position is - instead we return the error. FlushChannel
  3552.      * has already called Tcl_SetErrno() to report the error upwards.
  3553.      * If the flush succeeds we do the seek also.
  3554.      */
  3555.     
  3556.     if (FlushChannel(NULL, chanPtr, 0) != 0) {
  3557.         curPos = -1;
  3558.     } else {
  3559.  
  3560.         /*
  3561.          * Now seek to the new position in the channel as requested by the
  3562.          * caller.
  3563.          */
  3564.  
  3565.         curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
  3566.                 (long) offset, mode, &result);
  3567.         if (curPos == -1) {
  3568.             Tcl_SetErrno(result);
  3569.         }
  3570.     }
  3571.     
  3572.     /*
  3573.      * Restore to nonblocking mode if that was the previous behavior.
  3574.      *
  3575.      * NOTE: Even if there was an async flush active we do not restore
  3576.      * it now because we already flushed all the queued output, above.
  3577.      */
  3578.     
  3579.     if (wasAsync) {
  3580.         chanPtr->flags |= CHANNEL_NONBLOCKING;
  3581.         result = 0;
  3582.         if (chanPtr->typePtr->blockModeProc != NULL) {
  3583.             result = (chanPtr->typePtr->blockModeProc) (chanPtr->instanceData,
  3584.                     TCL_MODE_NONBLOCKING);
  3585.         }
  3586.         if (result != 0) {
  3587.             Tcl_SetErrno(result);
  3588.             return -1;
  3589.         }
  3590.     }
  3591.  
  3592.     return curPos;
  3593. }
  3594.  
  3595. /*
  3596.  *----------------------------------------------------------------------
  3597.  *
  3598.  * Tcl_Tell --
  3599.  *
  3600.  *    Returns the position of the next character to be read/written on
  3601.  *    this channel.
  3602.  *
  3603.  * Results:
  3604.  *    A nonnegative integer on success, -1 on failure. If failed,
  3605.  *    use Tcl_GetErrno() to retrieve the POSIX error code for the
  3606.  *    error that occurred.
  3607.  *
  3608.  * Side effects:
  3609.  *    None.
  3610.  *
  3611.  *----------------------------------------------------------------------
  3612.  */
  3613.  
  3614. int
  3615. Tcl_Tell(chan)
  3616.     Tcl_Channel chan;            /* The channel to return pos for. */
  3617. {
  3618.     Channel *chanPtr;            /* The actual channel to tell on. */
  3619.     ChannelBuffer *bufPtr;
  3620.     int inputBuffered, outputBuffered;
  3621.     int result;                /* Of calling device driver. */
  3622.     int curPos;                /* Position on device. */
  3623.  
  3624.     chanPtr = (Channel *) chan;
  3625.  
  3626.     /*
  3627.      * Check for unreported error.
  3628.      */
  3629.  
  3630.     if (chanPtr->unreportedError != 0) {
  3631.         Tcl_SetErrno(chanPtr->unreportedError);
  3632.         chanPtr->unreportedError = 0;
  3633.         return -1;
  3634.     }
  3635.  
  3636.     /*
  3637.      * Disallow tell on dead channels -- channels that have been closed but
  3638.      * not yet been deallocated. Such channels can be found if the exit
  3639.      * handler for channel cleanup has run but the channel is still
  3640.      * registered in an interpreter.
  3641.      */
  3642.  
  3643.     if (CheckForDeadChannel(NULL,chanPtr)) return -1;
  3644.  
  3645.     /*
  3646.      * Disallow tell on channels that are open for neither
  3647.      * writing nor reading (e.g. socket server channels).
  3648.      */
  3649.  
  3650.     if (!(chanPtr->flags & (TCL_WRITABLE|TCL_READABLE))) {
  3651.         Tcl_SetErrno(EACCES);
  3652.         return -1;
  3653.     }
  3654.  
  3655.     /*
  3656.      * If the channel is in the middle of a background copy, fail.
  3657.      */
  3658.  
  3659.     if (chanPtr->csPtr) {
  3660.     Tcl_SetErrno(EBUSY);
  3661.     return -1;
  3662.     }
  3663.  
  3664.     /*
  3665.      * Disallow tell on channels whose type does not have a seek procedure
  3666.      * defined. This means that the channel does not support seeking.
  3667.      */
  3668.  
  3669.     if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) NULL) {
  3670.         Tcl_SetErrno(EINVAL);
  3671.         return -1;
  3672.     }
  3673.  
  3674.     /*
  3675.      * Compute how much input and output is buffered. If both input and
  3676.      * output is buffered, cannot compute the current position.
  3677.      */
  3678.  
  3679.     for (bufPtr = chanPtr->inQueueHead, inputBuffered = 0;
  3680.              bufPtr != (ChannelBuffer *) NULL;
  3681.              bufPtr = bufPtr->nextPtr) {
  3682.         inputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
  3683.     }
  3684.     for (bufPtr = chanPtr->outQueueHead, outputBuffered = 0;
  3685.              bufPtr != (ChannelBuffer *) NULL;
  3686.              bufPtr = bufPtr->nextPtr) {
  3687.         outputBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
  3688.     }
  3689.     if ((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
  3690.            (chanPtr->curOutPtr->nextAdded > chanPtr->curOutPtr->nextRemoved)) {
  3691.         chanPtr->flags |= BUFFER_READY;
  3692.         outputBuffered +=
  3693.             (chanPtr->curOutPtr->nextAdded - chanPtr->curOutPtr->nextRemoved);
  3694.     }
  3695.  
  3696.     if ((inputBuffered != 0) && (outputBuffered != 0)) {
  3697.         Tcl_SetErrno(EFAULT);
  3698.         return -1;
  3699.     }
  3700.  
  3701.     /*
  3702.      * Get the current position in the device and compute the position
  3703.      * where the next character will be read or written.
  3704.      */
  3705.  
  3706.     curPos = (chanPtr->typePtr->seekProc) (chanPtr->instanceData,
  3707.             (long) 0, SEEK_CUR, &result);
  3708.     if (curPos == -1) {
  3709.         Tcl_SetErrno(result);
  3710.         return -1;
  3711.     }
  3712.     if (inputBuffered != 0) {
  3713.         return (curPos - inputBuffered);
  3714.     }
  3715.     return (curPos + outputBuffered);
  3716. }
  3717.  
  3718. /*
  3719.  *----------------------------------------------------------------------
  3720.  *
  3721.  * Tcl_Eof --
  3722.  *
  3723.  *    Returns 1 if the channel is at EOF, 0 otherwise.
  3724.  *
  3725.  * Results:
  3726.  *    1 or 0, always.
  3727.  *
  3728.  * Side effects:
  3729.  *    None.
  3730.  *
  3731.  *----------------------------------------------------------------------
  3732.  */
  3733.  
  3734. int
  3735. Tcl_Eof(chan)
  3736.     Tcl_Channel chan;            /* Does this channel have EOF? */
  3737. {
  3738.     Channel *chanPtr;        /* The real channel structure. */
  3739.  
  3740.     chanPtr = (Channel *) chan;
  3741.     return ((chanPtr->flags & CHANNEL_STICKY_EOF) ||
  3742.             ((chanPtr->flags & CHANNEL_EOF) && (Tcl_InputBuffered(chan) == 0)))
  3743.         ? 1 : 0;
  3744. }
  3745.  
  3746. /*
  3747.  *----------------------------------------------------------------------
  3748.  *
  3749.  * Tcl_InputBlocked --
  3750.  *
  3751.  *    Returns 1 if input is blocked on this channel, 0 otherwise.
  3752.  *
  3753.  * Results:
  3754.  *    0 or 1, always.
  3755.  *
  3756.  * Side effects:
  3757.  *    None.
  3758.  *
  3759.  *----------------------------------------------------------------------
  3760.  */
  3761.  
  3762. int
  3763. Tcl_InputBlocked(chan)
  3764.     Tcl_Channel chan;            /* Is this channel blocked? */
  3765. {
  3766.     Channel *chanPtr;        /* The real channel structure. */
  3767.  
  3768.     chanPtr = (Channel *) chan;
  3769.     return (chanPtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
  3770. }
  3771.  
  3772. /*
  3773.  *----------------------------------------------------------------------
  3774.  *
  3775.  * Tcl_InputBuffered --
  3776.  *
  3777.  *    Returns the number of bytes of input currently buffered in the
  3778.  *    internal buffer of a channel.
  3779.  *
  3780.  * Results:
  3781.  *    The number of input bytes buffered, or zero if the channel is not
  3782.  *    open for reading.
  3783.  *
  3784.  * Side effects:
  3785.  *    None.
  3786.  *
  3787.  *----------------------------------------------------------------------
  3788.  */
  3789.  
  3790. int
  3791. Tcl_InputBuffered(chan)
  3792.     Tcl_Channel chan;            /* The channel to query. */
  3793. {
  3794.     Channel *chanPtr;
  3795.     int bytesBuffered;
  3796.     ChannelBuffer *bufPtr;
  3797.  
  3798.     chanPtr = (Channel *) chan;
  3799.     for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
  3800.              bufPtr != (ChannelBuffer *) NULL;
  3801.              bufPtr = bufPtr->nextPtr) {
  3802.         bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
  3803.     }
  3804.     return bytesBuffered;
  3805. }
  3806.  
  3807. /*
  3808.  *----------------------------------------------------------------------
  3809.  *
  3810.  * Tcl_SetChannelBufferSize --
  3811.  *
  3812.  *    Sets the size of buffers to allocate to store input or output
  3813.  *    in the channel. The size must be between 10 bytes and 1 MByte.
  3814.  *
  3815.  * Results:
  3816.  *    None.
  3817.  *
  3818.  * Side effects:
  3819.  *    Sets the size of buffers subsequently allocated for this channel.
  3820.  *
  3821.  *----------------------------------------------------------------------
  3822.  */
  3823.  
  3824. void
  3825. Tcl_SetChannelBufferSize(chan, sz)
  3826.     Tcl_Channel chan;            /* The channel whose buffer size
  3827.                                          * to set. */
  3828.     int sz;                /* The size to set. */
  3829. {
  3830.     Channel *chanPtr;
  3831.     
  3832.     /*
  3833.      * If the buffer size is smaller than 10 bytes or larger than one MByte,
  3834.      * do not accept the requested size and leave the current buffer size.
  3835.      */
  3836.     
  3837.     if (sz < 10) {
  3838.         return;
  3839.     }
  3840.     if (sz > (1024 * 1024)) {
  3841.         return;
  3842.     }
  3843.  
  3844.     chanPtr = (Channel *) chan;
  3845.     chanPtr->bufSize = sz;
  3846. }
  3847.  
  3848. /*
  3849.  *----------------------------------------------------------------------
  3850.  *
  3851.  * Tcl_GetChannelBufferSize --
  3852.  *
  3853.  *    Retrieves the size of buffers to allocate for this channel.
  3854.  *
  3855.  * Results:
  3856.  *    The size.
  3857.  *
  3858.  * Side effects:
  3859.  *    None.
  3860.  *
  3861.  *----------------------------------------------------------------------
  3862.  */
  3863.  
  3864. int
  3865. Tcl_GetChannelBufferSize(chan)
  3866.     Tcl_Channel chan;        /* The channel for which to find the
  3867.                                  * buffer size. */
  3868. {
  3869.     Channel *chanPtr;
  3870.  
  3871.     chanPtr = (Channel *) chan;
  3872.     return chanPtr->bufSize;
  3873. }
  3874.  
  3875. /*
  3876.  *----------------------------------------------------------------------
  3877.  *
  3878.  * Tcl_BadChannelOption --
  3879.  *
  3880.  *    This procedure generates a "bad option" error message in an
  3881.  *    (optional) interpreter.  It is used by channel drivers when 
  3882.  *      a invalid Set/Get option is requested. Its purpose is to concatenate
  3883.  *      the generic options list to the specific ones and factorize
  3884.  *      the generic options error message string.
  3885.  *
  3886.  * Results:
  3887.  *    TCL_ERROR.
  3888.  *
  3889.  * Side effects:
  3890.  *    An error message is generated in interp's result object to
  3891.  *    indicate that a command was invoked with the a bad option
  3892.  *    The message has the form
  3893.  *        bad option "blah": should be one of 
  3894.  *              <...generic options...>+<...specific options...>
  3895.  *    "blah" is the optionName argument and "<specific options>"
  3896.  *    is a space separated list of specific option words.
  3897.  *      The function takes good care of inserting minus signs before
  3898.  *      each option, commas after, and an "or" before the last option.
  3899.  *
  3900.  *----------------------------------------------------------------------
  3901.  */
  3902.  
  3903. int
  3904. Tcl_BadChannelOption(interp, optionName, optionList)
  3905.     Tcl_Interp *interp;            /* Current interpreter. (can be NULL)*/
  3906.     char *optionName;            /* 'bad option' name */
  3907.     char *optionList;            /* Specific options list to append 
  3908.                      * to the standard generic options.
  3909.                      * can be NULL for generic options 
  3910.                      * only.
  3911.                      */
  3912. {
  3913.     if (interp) {
  3914.     CONST char *genericopt = 
  3915.             "blocking buffering buffersize eofchar translation";
  3916.     char **argv;
  3917.     int  argc, i;
  3918.     Tcl_DString ds;
  3919.  
  3920.     Tcl_DStringInit(&ds);
  3921.     Tcl_DStringAppend(&ds, (char *) genericopt, -1);
  3922.     if (optionList && (*optionList)) {
  3923.         Tcl_DStringAppend(&ds, " ", 1);
  3924.         Tcl_DStringAppend(&ds, optionList, -1);
  3925.     }
  3926.     if (Tcl_SplitList(interp, Tcl_DStringValue(&ds), 
  3927.                 &argc, &argv) != TCL_OK) {
  3928.         panic("malformed option list in channel driver");
  3929.     }
  3930.     Tcl_ResetResult(interp);
  3931.     Tcl_AppendResult(interp, "bad option \"", optionName, 
  3932.          "\": should be one of ", (char *) NULL);
  3933.     argc--;
  3934.     for (i = 0; i < argc; i++) {
  3935.         Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL);
  3936.     }
  3937.     Tcl_AppendResult(interp, "or -", argv[i], (char *) NULL);
  3938.     Tcl_DStringFree(&ds);
  3939.     ckfree((char *) argv);
  3940.     }
  3941.     Tcl_SetErrno(EINVAL);
  3942.     return TCL_ERROR;
  3943. }
  3944.  
  3945. /*
  3946.  *----------------------------------------------------------------------
  3947.  *
  3948.  * Tcl_GetChannelOption --
  3949.  *
  3950.  *    Gets a mode associated with an IO channel. If the optionName arg
  3951.  *    is non NULL, retrieves the value of that option. If the optionName
  3952.  *    arg is NULL, retrieves a list of alternating option names and
  3953.  *    values for the given channel.
  3954.  *
  3955.  * Results:
  3956.  *    A standard Tcl result. Also sets the supplied DString to the
  3957.  *    string value of the option(s) returned.
  3958.  *
  3959.  * Side effects:
  3960.  *      None.
  3961.  *
  3962.  *----------------------------------------------------------------------
  3963.  */
  3964.  
  3965. int
  3966. Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
  3967.     Tcl_Interp *interp;        /* For error reporting - can be NULL. */
  3968.     Tcl_Channel chan;        /* Channel on which to get option. */
  3969.     char *optionName;        /* Option to get. */
  3970.     Tcl_DString *dsPtr;        /* Where to store value(s). */
  3971. {
  3972.     size_t len;            /* Length of optionName string. */
  3973.     char optionVal[128];    /* Buffer for sprintf. */
  3974.     Channel *chanPtr = (Channel *) chan;
  3975.     int flags;
  3976.  
  3977.     /*
  3978.      * If we are in the middle of a background copy, use the saved flags.
  3979.      */
  3980.  
  3981.     if (chanPtr->csPtr) {
  3982.     if (chanPtr == chanPtr->csPtr->readPtr) {
  3983.         flags = chanPtr->csPtr->readFlags;
  3984.     } else {
  3985.         flags = chanPtr->csPtr->writeFlags;
  3986.     }
  3987.     } else {
  3988.     flags = chanPtr->flags;
  3989.     }
  3990.  
  3991.     /*
  3992.      * Disallow options on dead channels -- channels that have been closed but
  3993.      * not yet been deallocated. Such channels can be found if the exit
  3994.      * handler for channel cleanup has run but the channel is still
  3995.      * registered in an interpreter.
  3996.      */
  3997.  
  3998.     if (CheckForDeadChannel(interp,chanPtr)) return TCL_ERROR;
  3999.  
  4000.     /*
  4001.      * If the optionName is NULL it means that we want a list of all
  4002.      * options and values.
  4003.      */
  4004.     
  4005.     if (optionName == (char *) NULL) {
  4006.         len = 0;
  4007.     } else {
  4008.         len = strlen(optionName);
  4009.     }
  4010.     
  4011.     if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&
  4012.             (strncmp(optionName, "-blocking", len) == 0))) {
  4013.         if (len == 0) {
  4014.             Tcl_DStringAppendElement(dsPtr, "-blocking");
  4015.         }
  4016.         Tcl_DStringAppendElement(dsPtr,
  4017.         (flags & CHANNEL_NONBLOCKING) ? "0" : "1");
  4018.         if (len > 0) {
  4019.             return TCL_OK;
  4020.         }
  4021.     }
  4022.     if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
  4023.             (strncmp(optionName, "-buffering", len) == 0))) {
  4024.         if (len == 0) {
  4025.             Tcl_DStringAppendElement(dsPtr, "-buffering");
  4026.         }
  4027.         if (flags & CHANNEL_LINEBUFFERED) {
  4028.             Tcl_DStringAppendElement(dsPtr, "line");
  4029.         } else if (flags & CHANNEL_UNBUFFERED) {
  4030.             Tcl_DStringAppendElement(dsPtr, "none");
  4031.         } else {
  4032.             Tcl_DStringAppendElement(dsPtr, "full");
  4033.         }
  4034.         if (len > 0) {
  4035.             return TCL_OK;
  4036.         }
  4037.     }
  4038.     if ((len == 0) || ((len > 7) && (optionName[1] == 'b') &&
  4039.             (strncmp(optionName, "-buffersize", len) == 0))) {
  4040.         if (len == 0) {
  4041.             Tcl_DStringAppendElement(dsPtr, "-buffersize");
  4042.         }
  4043.         TclFormatInt(optionVal, chanPtr->bufSize);
  4044.         Tcl_DStringAppendElement(dsPtr, optionVal);
  4045.         if (len > 0) {
  4046.             return TCL_OK;
  4047.         }
  4048.     }
  4049.     if ((len == 0) ||
  4050.             ((len > 1) && (optionName[1] == 'e') &&
  4051.                     (strncmp(optionName, "-eofchar", len) == 0))) {
  4052.         if (len == 0) {
  4053.             Tcl_DStringAppendElement(dsPtr, "-eofchar");
  4054.         }
  4055.         if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
  4056.                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
  4057.             Tcl_DStringStartSublist(dsPtr);
  4058.         }
  4059.         if (flags & TCL_READABLE) {
  4060.             if (chanPtr->inEofChar == 0) {
  4061.                 Tcl_DStringAppendElement(dsPtr, "");
  4062.             } else {
  4063.                 char buf[4];
  4064.  
  4065.                 sprintf(buf, "%c", chanPtr->inEofChar);
  4066.                 Tcl_DStringAppendElement(dsPtr, buf);
  4067.             }
  4068.         }
  4069.         if (flags & TCL_WRITABLE) {
  4070.             if (chanPtr->outEofChar == 0) {
  4071.                 Tcl_DStringAppendElement(dsPtr, "");
  4072.             } else {
  4073.                 char buf[4];
  4074.  
  4075.                 sprintf(buf, "%c", chanPtr->outEofChar);
  4076.                 Tcl_DStringAppendElement(dsPtr, buf);
  4077.             }
  4078.         }
  4079.         if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
  4080.                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
  4081.             Tcl_DStringEndSublist(dsPtr);
  4082.         }
  4083.         if (len > 0) {
  4084.             return TCL_OK;
  4085.         }
  4086.     }
  4087.     if ((len == 0) ||
  4088.             ((len > 1) && (optionName[1] == 't') &&
  4089.                     (strncmp(optionName, "-translation", len) == 0))) {
  4090.         if (len == 0) {
  4091.             Tcl_DStringAppendElement(dsPtr, "-translation");
  4092.         }
  4093.         if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
  4094.                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
  4095.             Tcl_DStringStartSublist(dsPtr);
  4096.         }
  4097.         if (flags & TCL_READABLE) {
  4098.             if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
  4099.                 Tcl_DStringAppendElement(dsPtr, "auto");
  4100.             } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
  4101.                 Tcl_DStringAppendElement(dsPtr, "cr");
  4102.             } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
  4103.                 Tcl_DStringAppendElement(dsPtr, "crlf");
  4104.             } else {
  4105.                 Tcl_DStringAppendElement(dsPtr, "lf");
  4106.             }
  4107.         }
  4108.         if (flags & TCL_WRITABLE) {
  4109.             if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
  4110.                 Tcl_DStringAppendElement(dsPtr, "auto");
  4111.             } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
  4112.                 Tcl_DStringAppendElement(dsPtr, "cr");
  4113.             } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
  4114.                 Tcl_DStringAppendElement(dsPtr, "crlf");
  4115.             } else {
  4116.                 Tcl_DStringAppendElement(dsPtr, "lf");
  4117.             }
  4118.         }
  4119.         if (((flags & (TCL_READABLE|TCL_WRITABLE)) ==
  4120.                 (TCL_READABLE|TCL_WRITABLE)) && (len == 0)) {
  4121.             Tcl_DStringEndSublist(dsPtr);
  4122.         }
  4123.         if (len > 0) {
  4124.             return TCL_OK;
  4125.         }
  4126.     }
  4127.     if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) NULL) {
  4128.     /*
  4129.      * let the driver specific handle additional options
  4130.      * and result code and message.
  4131.      */
  4132.  
  4133.         return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
  4134.           interp, optionName, dsPtr);
  4135.     } else {
  4136.     /*
  4137.      * no driver specific options case.
  4138.      */
  4139.  
  4140.         if (len == 0) {
  4141.             return TCL_OK;
  4142.         }
  4143.     return Tcl_BadChannelOption(interp, optionName, NULL);
  4144.     }
  4145. }
  4146.  
  4147. /*
  4148.  *----------------------------------------------------------------------
  4149.  *
  4150.  * Tcl_SetChannelOption --
  4151.  *
  4152.  *    Sets an option on a channel.
  4153.  *
  4154.  * Results:
  4155.  *    A standard Tcl result. Also sets interp->result on error if
  4156.  *    interp is not NULL.
  4157.  *
  4158.  * Side effects:
  4159.  *    May modify an option on a device.
  4160.  *
  4161.  *----------------------------------------------------------------------
  4162.  */
  4163.  
  4164. int
  4165. Tcl_SetChannelOption(interp, chan, optionName, newValue)
  4166.     Tcl_Interp *interp;        /* For error reporting - can be NULL. */
  4167.     Tcl_Channel chan;        /* Channel on which to set mode. */
  4168.     char *optionName;        /* Which option to set? */
  4169.     char *newValue;        /* New value for option. */
  4170. {
  4171.     int newMode;        /* New (numeric) mode to sert. */
  4172.     Channel *chanPtr;        /* The real IO channel. */
  4173.     size_t len;            /* Length of optionName string. */
  4174.     int argc;
  4175.     char **argv;
  4176.     
  4177.     chanPtr = (Channel *) chan;
  4178.  
  4179.     /*
  4180.      * If the channel is in the middle of a background copy, fail.
  4181.      */
  4182.  
  4183.     if (chanPtr->csPtr) {
  4184.     if (interp) {
  4185.         Tcl_AppendResult(interp,
  4186.              "unable to set channel options: background copy in progress",
  4187.          (char *) NULL);
  4188.     }
  4189.         return TCL_ERROR;
  4190.     }
  4191.  
  4192.  
  4193.     /*
  4194.      * Disallow options on dead channels -- channels that have been closed but
  4195.      * not yet been deallocated. Such channels can be found if the exit
  4196.      * handler for channel cleanup has run but the channel is still
  4197.      * registered in an interpreter.
  4198.      */
  4199.  
  4200.     if (CheckForDeadChannel(NULL,chanPtr)) return TCL_ERROR;
  4201.     
  4202.     len = strlen(optionName);
  4203.  
  4204.     if ((len > 2) && (optionName[1] == 'b') &&
  4205.             (strncmp(optionName, "-blocking", len) == 0)) {
  4206.         if (Tcl_GetBoolean(interp, newValue, &newMode) == TCL_ERROR) {
  4207.             return TCL_ERROR;
  4208.         }
  4209.         if (newMode) {
  4210.             newMode = TCL_MODE_BLOCKING;
  4211.         } else {
  4212.             newMode = TCL_MODE_NONBLOCKING;
  4213.         }
  4214.     return SetBlockMode(interp, chanPtr, newMode);
  4215.     }
  4216.  
  4217.     if ((len > 7) && (optionName[1] == 'b') &&
  4218.             (strncmp(optionName, "-buffering", len) == 0)) {
  4219.         len = strlen(newValue);
  4220.         if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
  4221.             chanPtr->flags &=
  4222.                 (~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED));
  4223.         } else if ((newValue[0] == 'l') &&
  4224.                 (strncmp(newValue, "line", len) == 0)) {
  4225.             chanPtr->flags &= (~(CHANNEL_UNBUFFERED));
  4226.             chanPtr->flags |= CHANNEL_LINEBUFFERED;
  4227.         } else if ((newValue[0] == 'n') &&
  4228.                 (strncmp(newValue, "none", len) == 0)) {
  4229.             chanPtr->flags &= (~(CHANNEL_LINEBUFFERED));
  4230.             chanPtr->flags |= CHANNEL_UNBUFFERED;
  4231.         } else {
  4232.             if (interp) {
  4233.                 Tcl_AppendResult(interp, "bad value for -buffering: ",
  4234.                         "must be one of full, line, or none",
  4235.                         (char *) NULL);
  4236.                 return TCL_ERROR;
  4237.             }
  4238.         }
  4239.         return TCL_OK;
  4240.     }
  4241.  
  4242.     if ((len > 7) && (optionName[1] == 'b') &&
  4243.             (strncmp(optionName, "-buffersize", len) == 0)) {
  4244.         chanPtr->bufSize = atoi(newValue);
  4245.         if ((chanPtr->bufSize < 10) || (chanPtr->bufSize > (1024 * 1024))) {
  4246.             chanPtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE;
  4247.         }
  4248.         return TCL_OK;
  4249.     }
  4250.     
  4251.     if ((len > 1) && (optionName[1] == 'e') &&
  4252.             (strncmp(optionName, "-eofchar", len) == 0)) {
  4253.         if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
  4254.             return TCL_ERROR;
  4255.         }
  4256.         if (argc == 0) {
  4257.             chanPtr->inEofChar = 0;
  4258.             chanPtr->outEofChar = 0;
  4259.         } else if (argc == 1) {
  4260.             if (chanPtr->flags & TCL_WRITABLE) {
  4261.                 chanPtr->outEofChar = (int) argv[0][0];
  4262.             }
  4263.             if (chanPtr->flags & TCL_READABLE) {
  4264.                 chanPtr->inEofChar = (int) argv[0][0];
  4265.             }
  4266.         } else if (argc != 2) {
  4267.             if (interp) {
  4268.                 Tcl_AppendResult(interp,
  4269.                         "bad value for -eofchar: should be a list of one or",
  4270.                         " two elements", (char *) NULL);
  4271.             }
  4272.             ckfree((char *) argv);
  4273.             return TCL_ERROR;
  4274.         } else {
  4275.             if (chanPtr->flags & TCL_READABLE) {
  4276.                 chanPtr->inEofChar = (int) argv[0][0];
  4277.             }
  4278.             if (chanPtr->flags & TCL_WRITABLE) {
  4279.                 chanPtr->outEofChar = (int) argv[1][0];
  4280.             }
  4281.         }
  4282.         if (argv != (char **) NULL) {
  4283.             ckfree((char *) argv);
  4284.         }
  4285.         return TCL_OK;
  4286.     }
  4287.  
  4288.     if ((len > 1) && (optionName[1] == 't') &&
  4289.             (strncmp(optionName, "-translation", len) == 0)) {
  4290.     char *readMode, *writeMode;
  4291.  
  4292.         if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
  4293.             return TCL_ERROR;
  4294.         }
  4295.  
  4296.         if (argc == 1) {
  4297.         readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
  4298.         writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
  4299.     } else if (argc == 2) {
  4300.         readMode = (chanPtr->flags & TCL_READABLE) ? argv[0] : NULL;
  4301.         writeMode = (chanPtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
  4302.     } else {
  4303.             if (interp) {
  4304.                 Tcl_AppendResult(interp,
  4305.                         "bad value for -translation: must be a one or two",
  4306.                         " element list", (char *) NULL);
  4307.             }
  4308.             ckfree((char *) argv);
  4309.             return TCL_ERROR;
  4310.     }
  4311.  
  4312.     if (readMode) {
  4313.         if (*readMode == '\0') {
  4314.         newMode = chanPtr->inputTranslation;
  4315.         } else if (strcmp(readMode, "auto") == 0) {
  4316.         newMode = TCL_TRANSLATE_AUTO;
  4317.         } else if (strcmp(readMode, "binary") == 0) {
  4318.         chanPtr->inEofChar = 0;
  4319.         newMode = TCL_TRANSLATE_LF;
  4320.         } else if (strcmp(readMode, "lf") == 0) {
  4321.         newMode = TCL_TRANSLATE_LF;
  4322.         } else if (strcmp(readMode, "cr") == 0) {
  4323.         newMode = TCL_TRANSLATE_CR;
  4324.         } else if (strcmp(readMode, "crlf") == 0) {
  4325.         newMode = TCL_TRANSLATE_CRLF;
  4326.         } else if (strcmp(readMode, "platform") == 0) {
  4327.         newMode = TCL_PLATFORM_TRANSLATION;
  4328.         } else {
  4329.         if (interp) {
  4330.             Tcl_AppendResult(interp,
  4331.                 "bad value for -translation: ",
  4332.                 "must be one of auto, binary, cr, lf, crlf,",
  4333.                 " or platform", (char *) NULL);
  4334.         }
  4335.         ckfree((char *) argv);
  4336.         return TCL_ERROR;
  4337.         }
  4338.  
  4339.         /*
  4340.          * Reset the EOL flags since we need to look at any buffered
  4341.          * data to see if the new translation mode allows us to
  4342.          * complete the line.
  4343.          */
  4344.  
  4345.         if (newMode != chanPtr->inputTranslation) {
  4346.         chanPtr->inputTranslation = (Tcl_EolTranslation) newMode;
  4347.         chanPtr->flags &= ~(INPUT_SAW_CR);
  4348.         chanPtr->flags &= ~(CHANNEL_GETS_BLOCKED);
  4349.         UpdateInterest(chanPtr);
  4350.         }
  4351.     }
  4352.     if (writeMode) {
  4353.         if (*writeMode == '\0') {
  4354.         /* Do nothing. */
  4355.         } else if (strcmp(argv[0], "auto") == 0) {
  4356.         /*
  4357.          * This is a hack to get TCP sockets to produce output
  4358.          * in CRLF mode if they are being set into AUTO mode.
  4359.          * A better solution for achieving this effect will be
  4360.          * coded later.
  4361.          */
  4362.  
  4363.         if (strcmp(chanPtr->typePtr->typeName, "tcp") == 0) {
  4364.             chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
  4365.         } else {
  4366.             chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
  4367.         }
  4368.         } else if (strcmp(writeMode, "binary") == 0) {
  4369.         chanPtr->outEofChar = 0;
  4370.         chanPtr->outputTranslation = TCL_TRANSLATE_LF;
  4371.         } else if (strcmp(writeMode, "lf") == 0) {
  4372.         chanPtr->outputTranslation = TCL_TRANSLATE_LF;
  4373.         } else if (strcmp(writeMode, "cr") == 0) {
  4374.         chanPtr->outputTranslation = TCL_TRANSLATE_CR;
  4375.         } else if (strcmp(writeMode, "crlf") == 0) {
  4376.         chanPtr->outputTranslation = TCL_TRANSLATE_CRLF;
  4377.         } else if (strcmp(writeMode, "platform") == 0) {
  4378.         chanPtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
  4379.         } else {
  4380.         if (interp) {
  4381.             Tcl_AppendResult(interp,
  4382.                 "bad value for -translation: ",
  4383.                 "must be one of auto, binary, cr, lf, crlf,",
  4384.                 " or platform", (char *) NULL);
  4385.         }
  4386.         ckfree((char *) argv);
  4387.         return TCL_ERROR;
  4388.         }
  4389.     }
  4390.         ckfree((char *) argv);            
  4391.         return TCL_OK;
  4392.     }
  4393.  
  4394.     if (chanPtr->typePtr->setOptionProc != (Tcl_DriverSetOptionProc *) NULL) {
  4395.         return (chanPtr->typePtr->setOptionProc) (chanPtr->instanceData,
  4396.                 interp, optionName, newValue);
  4397.     }
  4398.     
  4399.     return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
  4400. }
  4401.  
  4402. /*
  4403.  *----------------------------------------------------------------------
  4404.  *
  4405.  * CleanupChannelHandlers --
  4406.  *
  4407.  *    Removes channel handlers that refer to the supplied interpreter,
  4408.  *    so that if the actual channel is not closed now, these handlers
  4409.  *    will not run on subsequent events on the channel. This would be
  4410.  *    erroneous, because the interpreter no longer has a reference to
  4411.  *    this channel.
  4412.  *
  4413.  * Results:
  4414.  *    None.
  4415.  *
  4416.  * Side effects:
  4417.  *    Removes channel handlers.
  4418.  *
  4419.  *----------------------------------------------------------------------
  4420.  */
  4421.  
  4422. static void
  4423. CleanupChannelHandlers(interp, chanPtr)
  4424.     Tcl_Interp *interp;
  4425.     Channel *chanPtr;
  4426. {
  4427.     EventScriptRecord *sPtr, *prevPtr, *nextPtr;
  4428.  
  4429.     /*
  4430.      * Remove fileevent records on this channel that refer to the
  4431.      * given interpreter.
  4432.      */
  4433.     
  4434.     for (sPtr = chanPtr->scriptRecordPtr,
  4435.              prevPtr = (EventScriptRecord *) NULL;
  4436.              sPtr != (EventScriptRecord *) NULL;
  4437.              sPtr = nextPtr) {
  4438.         nextPtr = sPtr->nextPtr;
  4439.         if (sPtr->interp == interp) {
  4440.             if (prevPtr == (EventScriptRecord *) NULL) {
  4441.                 chanPtr->scriptRecordPtr = nextPtr;
  4442.             } else {
  4443.                 prevPtr->nextPtr = nextPtr;
  4444.             }
  4445.  
  4446.             Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
  4447.                     ChannelEventScriptInvoker, (ClientData) sPtr);
  4448.  
  4449.         ckfree(sPtr->script);
  4450.             ckfree((char *) sPtr);
  4451.         } else {
  4452.             prevPtr = sPtr;
  4453.         }
  4454.     }
  4455. }
  4456.  
  4457. /*
  4458.  *----------------------------------------------------------------------
  4459.  *
  4460.  * Tcl_NotifyChannel --
  4461.  *
  4462.  *    This procedure is called by a channel driver when a driver
  4463.  *    detects an event on a channel.  This procedure is responsible
  4464.  *    for actually handling the event by invoking any channel
  4465.  *    handler callbacks.
  4466.  *
  4467.  * Results:
  4468.  *    None.
  4469.  *
  4470.  * Side effects:
  4471.  *    Whatever the channel handler callback procedure does.
  4472.  *
  4473.  *----------------------------------------------------------------------
  4474.  */
  4475.  
  4476. void
  4477. Tcl_NotifyChannel(channel, mask)
  4478.     Tcl_Channel channel;    /* Channel that detected an event. */
  4479.     int mask;            /* OR'ed combination of TCL_READABLE,
  4480.                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates
  4481.                  * which events were detected. */
  4482. {
  4483.     Channel *chanPtr = (Channel *) channel;
  4484.     ChannelHandler *chPtr;
  4485.     NextChannelHandler nh;
  4486.  
  4487.     Tcl_Preserve((ClientData)chanPtr);
  4488.  
  4489.     /*
  4490.      * If we are flushing in the background, be sure to call FlushChannel
  4491.      * for writable events.  Note that we have to discard the writable
  4492.      * event so we don't call any write handlers before the flush is
  4493.      * complete.
  4494.      */
  4495.  
  4496.     if ((chanPtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
  4497.     FlushChannel(NULL, chanPtr, 1);
  4498.     mask &= ~TCL_WRITABLE;
  4499.     }
  4500.  
  4501.     /*
  4502.      * Add this invocation to the list of recursive invocations of
  4503.      * ChannelHandlerEventProc.
  4504.      */
  4505.     
  4506.     nh.nextHandlerPtr = (ChannelHandler *) NULL;
  4507.     nh.nestedHandlerPtr = nestedHandlerPtr;
  4508.     nestedHandlerPtr = &nh;
  4509.     
  4510.     for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
  4511.  
  4512.         /*
  4513.          * If this channel handler is interested in any of the events that
  4514.          * have occurred on the channel, invoke its procedure.
  4515.          */
  4516.         
  4517.         if ((chPtr->mask & mask) != 0) {
  4518.             nh.nextHandlerPtr = chPtr->nextPtr;
  4519.         (*(chPtr->proc))(chPtr->clientData, mask);
  4520.             chPtr = nh.nextHandlerPtr;
  4521.         } else {
  4522.             chPtr = chPtr->nextPtr;
  4523.     }
  4524.     }
  4525.  
  4526.     /*
  4527.      * Update the notifier interest, since it may have changed after
  4528.      * invoking event handlers.
  4529.      */
  4530.  
  4531.     if (chanPtr->typePtr != NULL) {
  4532.     UpdateInterest(chanPtr);
  4533.     }
  4534.     Tcl_Release((ClientData)chanPtr);
  4535.  
  4536.     nestedHandlerPtr = nh.nestedHandlerPtr;
  4537. }
  4538.  
  4539. /*
  4540.  *----------------------------------------------------------------------
  4541.  *
  4542.  * UpdateInterest --
  4543.  *
  4544.  *    Arrange for the notifier to call us back at appropriate times
  4545.  *    based on the current state of the channel.
  4546.  *
  4547.  * Results:
  4548.  *    None.
  4549.  *
  4550.  * Side effects:
  4551.  *    May schedule a timer or driver handler.
  4552.  *
  4553.  *----------------------------------------------------------------------
  4554.  */
  4555.  
  4556. static void
  4557. UpdateInterest(chanPtr)
  4558.     Channel *chanPtr;        /* Channel to update. */
  4559. {
  4560.     int mask = chanPtr->interestMask;
  4561.  
  4562.     /*
  4563.      * If there are flushed buffers waiting to be written, then
  4564.      * we need to watch for the channel to become writable.
  4565.      */
  4566.  
  4567.     if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
  4568.     mask |= TCL_WRITABLE;
  4569.     }
  4570.  
  4571.     /*
  4572.      * If there is data in the input queue, and we aren't blocked waiting for
  4573.      * an EOL, then we need to schedule a timer so we don't block in the
  4574.      * notifier.  Also, cancel the read interest so we don't get duplicate
  4575.      * events.
  4576.      */
  4577.  
  4578.     if (mask & TCL_READABLE) {
  4579.     if (!(chanPtr->flags & CHANNEL_GETS_BLOCKED)
  4580.         && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
  4581.         && (chanPtr->inQueueHead->nextRemoved <
  4582.             chanPtr->inQueueHead->nextAdded)) {
  4583.         mask &= ~TCL_READABLE;
  4584.         if (!chanPtr->timer) {
  4585.         chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
  4586.             (ClientData) chanPtr);
  4587.         }
  4588.     }
  4589.     }
  4590.     (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
  4591. }
  4592.  
  4593. /*
  4594.  *----------------------------------------------------------------------
  4595.  *
  4596.  * ChannelTimerProc --
  4597.  *
  4598.  *    Timer handler scheduled by UpdateInterest to monitor the
  4599.  *    channel buffers until they are empty.
  4600.  *
  4601.  * Results:
  4602.  *    None.
  4603.  *
  4604.  * Side effects:
  4605.  *    May invoke channel handlers.
  4606.  *
  4607.  *----------------------------------------------------------------------
  4608.  */
  4609.  
  4610. static void
  4611. ChannelTimerProc(clientData)
  4612.     ClientData clientData;
  4613. {
  4614.     Channel *chanPtr = (Channel *) clientData;
  4615.  
  4616.     if (!(chanPtr->flags & CHANNEL_GETS_BLOCKED)
  4617.         && (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
  4618.         && (chanPtr->inQueueHead->nextRemoved <
  4619.             chanPtr->inQueueHead->nextAdded)) {
  4620.     /*
  4621.      * Restart the timer in case a channel handler reenters the
  4622.      * event loop before UpdateInterest gets called by Tcl_NotifyChannel.
  4623.      */
  4624.  
  4625.     chanPtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
  4626.             (ClientData) chanPtr);
  4627.     Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
  4628.  
  4629.    } else {
  4630.     chanPtr->timer = NULL;
  4631.     UpdateInterest(chanPtr);
  4632.     }
  4633. }
  4634.  
  4635. /*
  4636.  *----------------------------------------------------------------------
  4637.  *
  4638.  * Tcl_CreateChannelHandler --
  4639.  *
  4640.  *    Arrange for a given procedure to be invoked whenever the
  4641.  *    channel indicated by the chanPtr arg becomes readable or
  4642.  *    writable.
  4643.  *
  4644.  * Results:
  4645.  *    None.
  4646.  *
  4647.  * Side effects:
  4648.  *    From now on, whenever the I/O channel given by chanPtr becomes
  4649.  *    ready in the way indicated by mask, proc will be invoked.
  4650.  *    See the manual entry for details on the calling sequence
  4651.  *    to proc.  If there is already an event handler for chan, proc
  4652.  *    and clientData, then the mask will be updated.
  4653.  *
  4654.  *----------------------------------------------------------------------
  4655.  */
  4656.  
  4657. void
  4658. Tcl_CreateChannelHandler(chan, mask, proc, clientData)
  4659.     Tcl_Channel chan;        /* The channel to create the handler for. */
  4660.     int mask;            /* OR'ed combination of TCL_READABLE,
  4661.                  * TCL_WRITABLE, and TCL_EXCEPTION:
  4662.                  * indicates conditions under which
  4663.                  * proc should be called. Use 0 to
  4664.                                  * disable a registered handler. */
  4665.     Tcl_ChannelProc *proc;    /* Procedure to call for each
  4666.                  * selected event. */
  4667.     ClientData clientData;    /* Arbitrary data to pass to proc. */
  4668. {
  4669.     ChannelHandler *chPtr;
  4670.     Channel *chanPtr;
  4671.  
  4672.     chanPtr = (Channel *) chan;
  4673.     
  4674.     /*
  4675.      * Check whether this channel handler is not already registered. If
  4676.      * it is not, create a new record, else reuse existing record (smash
  4677.      * current values).
  4678.      */
  4679.  
  4680.     for (chPtr = chanPtr->chPtr;
  4681.              chPtr != (ChannelHandler *) NULL;
  4682.              chPtr = chPtr->nextPtr) {
  4683.         if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
  4684.                 (chPtr->clientData == clientData)) {
  4685.             break;
  4686.         }
  4687.     }
  4688.     if (chPtr == (ChannelHandler *) NULL) {
  4689.         chPtr = (ChannelHandler *) ckalloc((unsigned) sizeof(ChannelHandler));
  4690.         chPtr->mask = 0;
  4691.         chPtr->proc = proc;
  4692.         chPtr->clientData = clientData;
  4693.         chPtr->chanPtr = chanPtr;
  4694.         chPtr->nextPtr = chanPtr->chPtr;
  4695.         chanPtr->chPtr = chPtr;
  4696.     }
  4697.  
  4698.     /*
  4699.      * The remainder of the initialization below is done regardless of
  4700.      * whether or not this is a new record or a modification of an old
  4701.      * one.
  4702.      */
  4703.  
  4704.     chPtr->mask = mask;
  4705.  
  4706.     /*
  4707.      * Recompute the interest mask for the channel - this call may actually
  4708.      * be disabling an existing handler.
  4709.      */
  4710.     
  4711.     chanPtr->interestMask = 0;
  4712.     for (chPtr = chanPtr->chPtr;
  4713.      chPtr != (ChannelHandler *) NULL;
  4714.      chPtr = chPtr->nextPtr) {
  4715.     chanPtr->interestMask |= chPtr->mask;
  4716.     }
  4717.  
  4718.     UpdateInterest(chanPtr);
  4719. }
  4720.  
  4721. /*
  4722.  *----------------------------------------------------------------------
  4723.  *
  4724.  * Tcl_DeleteChannelHandler --
  4725.  *
  4726.  *    Cancel a previously arranged callback arrangement for an IO
  4727.  *    channel.
  4728.  *
  4729.  * Results:
  4730.  *    None.
  4731.  *
  4732.  * Side effects:
  4733.  *    If a callback was previously registered for this chan, proc and
  4734.  *     clientData , it is removed and the callback will no longer be called
  4735.  *    when the channel becomes ready for IO.
  4736.  *
  4737.  *----------------------------------------------------------------------
  4738.  */
  4739.  
  4740. void
  4741. Tcl_DeleteChannelHandler(chan, proc, clientData)
  4742.     Tcl_Channel chan;        /* The channel for which to remove the
  4743.                                  * callback. */
  4744.     Tcl_ChannelProc *proc;    /* The procedure in the callback to delete. */
  4745.     ClientData clientData;    /* The client data in the callback
  4746.                                  * to delete. */
  4747.     
  4748. {
  4749.     ChannelHandler *chPtr, *prevChPtr;
  4750.     Channel *chanPtr;
  4751.     NextChannelHandler *nhPtr;
  4752.  
  4753.     chanPtr = (Channel *) chan;
  4754.  
  4755.     /*
  4756.      * Find the entry and the previous one in the list.
  4757.      */
  4758.  
  4759.     for (prevChPtr = (ChannelHandler *) NULL, chPtr = chanPtr->chPtr;
  4760.              chPtr != (ChannelHandler *) NULL;
  4761.              chPtr = chPtr->nextPtr) {
  4762.         if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
  4763.                 && (chPtr->proc == proc)) {
  4764.             break;
  4765.         }
  4766.         prevChPtr = chPtr;
  4767.     }
  4768.     
  4769.     /*
  4770.      * If not found, return without doing anything.
  4771.      */
  4772.  
  4773.     if (chPtr == (ChannelHandler *) NULL) {
  4774.         return;
  4775.     }
  4776.  
  4777.     /*
  4778.      * If ChannelHandlerEventProc is about to process this handler, tell it to
  4779.      * process the next one instead - we are going to delete *this* one.
  4780.      */
  4781.  
  4782.     for (nhPtr = nestedHandlerPtr;
  4783.              nhPtr != (NextChannelHandler *) NULL;
  4784.              nhPtr = nhPtr->nestedHandlerPtr) {
  4785.         if (nhPtr->nextHandlerPtr == chPtr) {
  4786.             nhPtr->nextHandlerPtr = chPtr->nextPtr;
  4787.         }
  4788.     }
  4789.  
  4790.     /*
  4791.      * Splice it out of the list of channel handlers.
  4792.      */
  4793.     
  4794.     if (prevChPtr == (ChannelHandler *) NULL) {
  4795.         chanPtr->chPtr = chPtr->nextPtr;
  4796.     } else {
  4797.         prevChPtr->nextPtr = chPtr->nextPtr;
  4798.     }
  4799.     ckfree((char *) chPtr);
  4800.  
  4801.     /*
  4802.      * Recompute the interest list for the channel, so that infinite loops
  4803.      * will not result if Tcl_DeleteChanelHandler is called inside an event.
  4804.      */
  4805.  
  4806.     chanPtr->interestMask = 0;
  4807.     for (chPtr = chanPtr->chPtr;
  4808.              chPtr != (ChannelHandler *) NULL;
  4809.              chPtr = chPtr->nextPtr) {
  4810.         chanPtr->interestMask |= chPtr->mask;
  4811.     }
  4812.  
  4813.     UpdateInterest(chanPtr);
  4814. }
  4815.  
  4816. /*
  4817.  *----------------------------------------------------------------------
  4818.  *
  4819.  * DeleteScriptRecord --
  4820.  *
  4821.  *    Delete a script record for this combination of channel, interp
  4822.  *    and mask.
  4823.  *
  4824.  * Results:
  4825.  *    None.
  4826.  *
  4827.  * Side effects:
  4828.  *    Deletes a script record and cancels a channel event handler.
  4829.  *
  4830.  *----------------------------------------------------------------------
  4831.  */
  4832.  
  4833. static void
  4834. DeleteScriptRecord(interp, chanPtr, mask)
  4835.     Tcl_Interp *interp;        /* Interpreter in which script was to be
  4836.                                  * executed. */
  4837.     Channel *chanPtr;        /* The channel for which to delete the
  4838.                                  * script record (if any). */
  4839.     int mask;            /* Events in mask must exactly match mask
  4840.                                  * of script to delete. */
  4841. {
  4842.     EventScriptRecord *esPtr, *prevEsPtr;
  4843.  
  4844.     for (esPtr = chanPtr->scriptRecordPtr,
  4845.              prevEsPtr = (EventScriptRecord *) NULL;
  4846.              esPtr != (EventScriptRecord *) NULL;
  4847.              prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
  4848.         if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
  4849.             if (esPtr == chanPtr->scriptRecordPtr) {
  4850.                 chanPtr->scriptRecordPtr = esPtr->nextPtr;
  4851.             } else {
  4852.                 prevEsPtr->nextPtr = esPtr->nextPtr;
  4853.             }
  4854.  
  4855.             Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
  4856.                     ChannelEventScriptInvoker, (ClientData) esPtr);
  4857.             
  4858.         ckfree(esPtr->script);
  4859.             ckfree((char *) esPtr);
  4860.  
  4861.             break;
  4862.         }
  4863.     }
  4864. }
  4865.  
  4866. /*
  4867.  *----------------------------------------------------------------------
  4868.  *
  4869.  * CreateScriptRecord --
  4870.  *
  4871.  *    Creates a record to store a script to be executed when a specific
  4872.  *    event fires on a specific channel.
  4873.  *
  4874.  * Results:
  4875.  *    None.
  4876.  *
  4877.  * Side effects:
  4878.  *    Causes the script to be stored for later execution.
  4879.  *
  4880.  *----------------------------------------------------------------------
  4881.  */
  4882.  
  4883. static void
  4884. CreateScriptRecord(interp, chanPtr, mask, script)
  4885.     Tcl_Interp *interp;            /* Interpreter in which to execute
  4886.                                          * the stored script. */
  4887.     Channel *chanPtr;            /* Channel for which script is to
  4888.                                          * be stored. */
  4889.     int mask;                /* Set of events for which script
  4890.                                          * will be invoked. */
  4891.     char *script;            /* A copy of this script is stored
  4892.                                          * in the newly created record. */
  4893. {
  4894.     EventScriptRecord *esPtr;
  4895.  
  4896.     for (esPtr = chanPtr->scriptRecordPtr;
  4897.              esPtr != (EventScriptRecord *) NULL;
  4898.              esPtr = esPtr->nextPtr) {
  4899.         if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
  4900.         ckfree(esPtr->script);
  4901.             esPtr->script = (char *) NULL;
  4902.             break;
  4903.         }
  4904.     }
  4905.     if (esPtr == (EventScriptRecord *) NULL) {
  4906.         esPtr = (EventScriptRecord *) ckalloc((unsigned)
  4907.                 sizeof(EventScriptRecord));
  4908.         Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
  4909.                 ChannelEventScriptInvoker, (ClientData) esPtr);
  4910.         esPtr->nextPtr = chanPtr->scriptRecordPtr;
  4911.         chanPtr->scriptRecordPtr = esPtr;
  4912.     }
  4913.     esPtr->chanPtr = chanPtr;
  4914.     esPtr->interp = interp;
  4915.     esPtr->mask = mask;
  4916.     esPtr->script = ckalloc((unsigned) (strlen(script) + 1));
  4917.     strcpy(esPtr->script, script);
  4918. }
  4919.  
  4920. /*
  4921.  *----------------------------------------------------------------------
  4922.  *
  4923.  * ChannelEventScriptInvoker --
  4924.  *
  4925.  *    Invokes a script scheduled by "fileevent" for when the channel
  4926.  *    becomes ready for IO. This function is invoked by the channel
  4927.  *    handler which was created by the Tcl "fileevent" command.
  4928.  *
  4929.  * Results:
  4930.  *    None.
  4931.  *
  4932.  * Side effects:
  4933.  *    Whatever the script does.
  4934.  *
  4935.  *----------------------------------------------------------------------
  4936.  */
  4937.  
  4938. static void
  4939. ChannelEventScriptInvoker(clientData, mask)
  4940.     ClientData clientData;    /* The script+interp record. */
  4941.     int mask;            /* Not used. */
  4942. {
  4943.     Tcl_Interp *interp;        /* Interpreter in which to eval the script. */
  4944.     Channel *chanPtr;        /* The channel for which this handler is
  4945.                                  * registered. */
  4946.     char *script;        /* Script to eval. */
  4947.     EventScriptRecord *esPtr;    /* The event script + interpreter to eval it
  4948.                                  * in. */
  4949.     int result;            /* Result of call to eval script. */
  4950.  
  4951.     esPtr = (EventScriptRecord *) clientData;
  4952.  
  4953.     chanPtr = esPtr->chanPtr;
  4954.     mask = esPtr->mask;
  4955.     interp = esPtr->interp;
  4956.     script = esPtr->script;
  4957.  
  4958.     /*
  4959.      * We must preserve the interpreter so we can report errors on it
  4960.      * later.  Note that we do not need to preserve the channel because
  4961.      * that is done by Tcl_NotifyChannel before calling channel handlers.
  4962.      */
  4963.     
  4964.     Tcl_Preserve((ClientData) interp);
  4965.     result = Tcl_GlobalEval(interp, script);
  4966.  
  4967.     /*
  4968.      * On error, cause a background error and remove the channel handler
  4969.      * and the script record.
  4970.      *
  4971.      * NOTE: Must delete channel handler before causing the background error
  4972.      * because the background error may want to reinstall the handler.
  4973.      */
  4974.     
  4975.     if (result != TCL_OK) {
  4976.     if (chanPtr->typePtr != NULL) {
  4977.         DeleteScriptRecord(interp, chanPtr, mask);
  4978.     }
  4979.         Tcl_BackgroundError(interp);
  4980.     }
  4981.     Tcl_Release((ClientData) interp);
  4982. }
  4983.  
  4984. /*
  4985.  *----------------------------------------------------------------------
  4986.  *
  4987.  * Tcl_FileEventCmd --
  4988.  *
  4989.  *    This procedure implements the "fileevent" Tcl command. See the
  4990.  *    user documentation for details on what it does. This command is
  4991.  *    based on the Tk command "fileevent" which in turn is based on work
  4992.  *    contributed by Mark Diekhans.
  4993.  *
  4994.  * Results:
  4995.  *    A standard Tcl result.
  4996.  *
  4997.  * Side effects:
  4998.  *    May create a channel handler for the specified channel.
  4999.  *
  5000.  *----------------------------------------------------------------------
  5001.  */
  5002.  
  5003.     /* ARGSUSED */
  5004. int
  5005. Tcl_FileEventCmd(clientData, interp, argc, argv)
  5006.     ClientData clientData;        /* Not used. */
  5007.     Tcl_Interp *interp;            /* Interpreter in which the channel
  5008.                                          * for which to create the handler
  5009.                                          * is found. */
  5010.     int argc;                /* Number of arguments. */
  5011.     char **argv;            /* Argument strings. */
  5012. {
  5013.     Channel *chanPtr;            /* The channel to create
  5014.                                          * the handler for. */
  5015.     Tcl_Channel chan;            /* The opaque type for the channel. */
  5016.     int c;                /* First char of mode argument. */
  5017.     int mask;                /* Mask for events of interest. */
  5018.     size_t length;            /* Length of mode argument. */
  5019.  
  5020.     /*
  5021.      * Parse arguments.
  5022.      */
  5023.  
  5024.     if ((argc != 3) && (argc != 4)) {
  5025.     Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0],
  5026.         " channelId event ?script?", (char *) NULL);
  5027.     return TCL_ERROR;
  5028.     }
  5029.     c = argv[2][0];
  5030.     length = strlen(argv[2]);
  5031.     if ((c == 'r') && (strncmp(argv[2], "readable", length) == 0)) {
  5032.         mask = TCL_READABLE;
  5033.     } else if ((c == 'w') && (strncmp(argv[2], "writable", length) == 0)) {
  5034.         mask = TCL_WRITABLE;
  5035.     } else {
  5036.     Tcl_AppendResult(interp, "bad event name \"", argv[2],
  5037.         "\": must be readable or writable", (char *) NULL);
  5038.     return TCL_ERROR;
  5039.     }
  5040.     chan = Tcl_GetChannel(interp, argv[1], NULL);
  5041.     if (chan == (Tcl_Channel) NULL) {
  5042.         return TCL_ERROR;
  5043.     }
  5044.     
  5045.     chanPtr = (Channel *) chan;
  5046.     if ((chanPtr->flags & mask) == 0) {
  5047.         Tcl_AppendResult(interp, "channel is not ",
  5048.                 (mask == TCL_READABLE) ? "readable" : "writable",
  5049.                 (char *) NULL);
  5050.         return TCL_ERROR;
  5051.     }
  5052.     
  5053.     /*
  5054.      * If we are supposed to return the script, do so.
  5055.      */
  5056.  
  5057.     if (argc == 3) {
  5058.     EventScriptRecord *esPtr;
  5059.     for (esPtr = chanPtr->scriptRecordPtr;
  5060.              esPtr != (EventScriptRecord *) NULL;
  5061.              esPtr = esPtr->nextPtr) {
  5062.         if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
  5063.         Tcl_SetResult(interp, esPtr->script, TCL_STATIC);
  5064.         break;
  5065.         }
  5066.     }
  5067.         return TCL_OK;
  5068.     }
  5069.  
  5070.     /*
  5071.      * If we are supposed to delete a stored script, do so.
  5072.      */
  5073.  
  5074.     if (argv[3][0] == 0) {
  5075.         DeleteScriptRecord(interp, chanPtr, mask);
  5076.         return TCL_OK;
  5077.     }
  5078.  
  5079.     /*
  5080.      * Make the script record that will link between the event and the
  5081.      * script to invoke. This also creates a channel event handler which
  5082.      * will evaluate the script in the supplied interpreter.
  5083.      */
  5084.  
  5085.     CreateScriptRecord(interp, chanPtr, mask, argv[3]);
  5086.     
  5087.     return TCL_OK;
  5088. }
  5089.  
  5090. /*
  5091.  *----------------------------------------------------------------------
  5092.  *
  5093.  * TclTestChannelCmd --
  5094.  *
  5095.  *    Implements the Tcl "testchannel" debugging command and its
  5096.  *    subcommands. This is part of the testing environment but must be
  5097.  *    in this file instead of tclTest.c because it needs access to the
  5098.  *    fields of struct Channel.
  5099.  *
  5100.  * Results:
  5101.  *    A standard Tcl result.
  5102.  *
  5103.  * Side effects:
  5104.  *    None.
  5105.  *
  5106.  *----------------------------------------------------------------------
  5107.  */
  5108.  
  5109.     /* ARGSUSED */
  5110. int
  5111. TclTestChannelCmd(clientData, interp, argc, argv)
  5112.     ClientData clientData;    /* Not used. */
  5113.     Tcl_Interp *interp;        /* Interpreter for result. */
  5114.     int argc;            /* Count of additional args. */
  5115.     char **argv;        /* Additional arg strings. */
  5116. {
  5117.     char *cmdName;        /* Sub command. */
  5118.     Tcl_HashTable *hTblPtr;    /* Hash table of channels. */
  5119.     Tcl_HashSearch hSearch;    /* Search variable. */
  5120.     Tcl_HashEntry *hPtr;    /* Search variable. */
  5121.     Channel *chanPtr;        /* The actual channel. */
  5122.     Tcl_Channel chan;        /* The opaque type. */
  5123.     size_t len;            /* Length of subcommand string. */
  5124.     int IOQueued;        /* How much IO is queued inside channel? */
  5125.     ChannelBuffer *bufPtr;    /* For iterating over queued IO. */
  5126.     char buf[128];        /* For sprintf. */
  5127.     
  5128.     if (argc < 2) {
  5129.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  5130.                 " subcommand ?additional args..?\"", (char *) NULL);
  5131.         return TCL_ERROR;
  5132.     }
  5133.     cmdName = argv[1];
  5134.     len = strlen(cmdName);
  5135.  
  5136.     chanPtr = (Channel *) NULL;
  5137.     if (argc > 2) {
  5138.         chan = Tcl_GetChannel(interp, argv[2], NULL);
  5139.         if (chan == (Tcl_Channel) NULL) {
  5140.             return TCL_ERROR;
  5141.         }
  5142.         chanPtr = (Channel *) chan;
  5143.     }
  5144.     
  5145.     if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
  5146.         if (argc != 3) {
  5147.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  5148.                     " info channelName\"", (char *) NULL);
  5149.             return TCL_ERROR;
  5150.         }
  5151.         Tcl_AppendElement(interp, argv[2]);
  5152.         Tcl_AppendElement(interp, chanPtr->typePtr->typeName);
  5153.         if (chanPtr->flags & TCL_READABLE) {
  5154.             Tcl_AppendElement(interp, "read");
  5155.         } else {
  5156.             Tcl_AppendElement(interp, "");
  5157.         }
  5158.         if (chanPtr->flags & TCL_WRITABLE) {
  5159.             Tcl_AppendElement(interp, "write");
  5160.         } else {
  5161.             Tcl_AppendElement(interp, "");
  5162.         }
  5163.         if (chanPtr->flags & CHANNEL_NONBLOCKING) {
  5164.             Tcl_AppendElement(interp, "nonblocking");
  5165.         } else {
  5166.             Tcl_AppendElement(interp, "blocking");
  5167.         }
  5168.         if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
  5169.             Tcl_AppendElement(interp, "line");
  5170.         } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
  5171.             Tcl_AppendElement(interp, "none");
  5172.         } else {
  5173.             Tcl_AppendElement(interp, "full");
  5174.         }
  5175.         if (chanPtr->flags & BG_FLUSH_SCHEDULED) {
  5176.             Tcl_AppendElement(interp, "async_flush");
  5177.         } else {
  5178.             Tcl_AppendElement(interp, "");
  5179.         }
  5180.         if (chanPtr->flags & CHANNEL_EOF) {
  5181.             Tcl_AppendElement(interp, "eof");
  5182.         } else {
  5183.             Tcl_AppendElement(interp, "");
  5184.         }
  5185.         if (chanPtr->flags & CHANNEL_BLOCKED) {
  5186.             Tcl_AppendElement(interp, "blocked");
  5187.         } else {
  5188.             Tcl_AppendElement(interp, "unblocked");
  5189.         }
  5190.         if (chanPtr->inputTranslation == TCL_TRANSLATE_AUTO) {
  5191.             Tcl_AppendElement(interp, "auto");
  5192.             if (chanPtr->flags & INPUT_SAW_CR) {
  5193.                 Tcl_AppendElement(interp, "saw_cr");
  5194.             } else {
  5195.                 Tcl_AppendElement(interp, "");
  5196.             }
  5197.         } else if (chanPtr->inputTranslation == TCL_TRANSLATE_LF) {
  5198.             Tcl_AppendElement(interp, "lf");
  5199.             Tcl_AppendElement(interp, "");
  5200.         } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CR) {
  5201.             Tcl_AppendElement(interp, "cr");
  5202.             Tcl_AppendElement(interp, "");
  5203.         } else if (chanPtr->inputTranslation == TCL_TRANSLATE_CRLF) {
  5204.             Tcl_AppendElement(interp, "crlf");
  5205.             if (chanPtr->flags & INPUT_SAW_CR) {
  5206.                 Tcl_AppendElement(interp, "queued_cr");
  5207.             } else {
  5208.                 Tcl_AppendElement(interp, "");
  5209.             }
  5210.         }
  5211.         if (chanPtr->outputTranslation == TCL_TRANSLATE_AUTO) {
  5212.             Tcl_AppendElement(interp, "auto");
  5213.         } else if (chanPtr->outputTranslation == TCL_TRANSLATE_LF) {
  5214.             Tcl_AppendElement(interp, "lf");
  5215.         } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CR) {
  5216.             Tcl_AppendElement(interp, "cr");
  5217.         } else if (chanPtr->outputTranslation == TCL_TRANSLATE_CRLF) {
  5218.             Tcl_AppendElement(interp, "crlf");
  5219.         }
  5220.         for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
  5221.                  bufPtr != (ChannelBuffer *) NULL;
  5222.                  bufPtr = bufPtr->nextPtr) {
  5223.             IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
  5224.         }
  5225.         TclFormatInt(buf, IOQueued);
  5226.         Tcl_AppendElement(interp, buf);
  5227.         
  5228.         IOQueued = 0;
  5229.         if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
  5230.             IOQueued = chanPtr->curOutPtr->nextAdded -
  5231.                 chanPtr->curOutPtr->nextRemoved;
  5232.         }
  5233.         for (bufPtr = chanPtr->outQueueHead;
  5234.                  bufPtr != (ChannelBuffer *) NULL;
  5235.                  bufPtr = bufPtr->nextPtr) {
  5236.             IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
  5237.         }
  5238.         TclFormatInt(buf, IOQueued);
  5239.         Tcl_AppendElement(interp, buf);
  5240.         
  5241.         TclFormatInt(buf, Tcl_Tell((Tcl_Channel) chanPtr));
  5242.         Tcl_AppendElement(interp, buf);
  5243.  
  5244.         TclFormatInt(buf, chanPtr->refCount);
  5245.         Tcl_AppendElement(interp, buf);
  5246.  
  5247.         return TCL_OK;
  5248.     }
  5249.  
  5250.     if ((cmdName[0] == 'i') &&
  5251.             (strncmp(cmdName, "inputbuffered", len) == 0)) {
  5252.         if (argc != 3) {
  5253.             Tcl_AppendResult(interp, "channel name required",
  5254.                     (char *) NULL);
  5255.             return TCL_ERROR;
  5256.         }
  5257.         
  5258.         for (IOQueued = 0, bufPtr = chanPtr->inQueueHead;
  5259.                  bufPtr != (ChannelBuffer *) NULL;
  5260.                  bufPtr = bufPtr->nextPtr) {
  5261.             IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
  5262.         }
  5263.         sprintf(buf, "%d", IOQueued);
  5264.         Tcl_AppendResult(interp, buf, (char *) NULL);
  5265.         return TCL_OK;
  5266.     }
  5267.         
  5268.     if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
  5269.         if (argc != 3) {
  5270.             Tcl_AppendResult(interp, "channel name required",
  5271.                     (char *) NULL);
  5272.             return TCL_ERROR;
  5273.         }
  5274.         
  5275.         if (chanPtr->flags & TCL_READABLE) {
  5276.             Tcl_AppendElement(interp, "read");
  5277.         } else {
  5278.             Tcl_AppendElement(interp, "");
  5279.         }
  5280.         if (chanPtr->flags & TCL_WRITABLE) {
  5281.             Tcl_AppendElement(interp, "write");
  5282.         } else {
  5283.             Tcl_AppendElement(interp, "");
  5284.         }
  5285.         return TCL_OK;
  5286.     }
  5287.     
  5288.     if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
  5289.         if (argc != 3) {
  5290.             Tcl_AppendResult(interp, "channel name required",
  5291.                     (char *) NULL);
  5292.             return TCL_ERROR;
  5293.         }
  5294.         Tcl_AppendResult(interp, chanPtr->channelName, (char *) NULL);
  5295.         return TCL_OK;
  5296.     }
  5297.     
  5298.     if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
  5299.         hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
  5300.         if (hTblPtr == (Tcl_HashTable *) NULL) {
  5301.             return TCL_OK;
  5302.         }
  5303.         for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
  5304.                  hPtr != (Tcl_HashEntry *) NULL;
  5305.                  hPtr = Tcl_NextHashEntry(&hSearch)) {
  5306.             Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
  5307.         }
  5308.         return TCL_OK;
  5309.     }
  5310.  
  5311.     if ((cmdName[0] == 'o') &&
  5312.             (strncmp(cmdName, "outputbuffered", len) == 0)) {
  5313.         if (argc != 3) {
  5314.             Tcl_AppendResult(interp, "channel name required",
  5315.                     (char *) NULL);
  5316.             return TCL_ERROR;
  5317.         }
  5318.         
  5319.         IOQueued = 0;
  5320.         if (chanPtr->curOutPtr != (ChannelBuffer *) NULL) {
  5321.             IOQueued = chanPtr->curOutPtr->nextAdded -
  5322.                 chanPtr->curOutPtr->nextRemoved;
  5323.         }
  5324.         for (bufPtr = chanPtr->outQueueHead;
  5325.                  bufPtr != (ChannelBuffer *) NULL;
  5326.                  bufPtr = bufPtr->nextPtr) {
  5327.             IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
  5328.         }
  5329.         sprintf(buf, "%d", IOQueued);
  5330.         Tcl_AppendResult(interp, buf, (char *) NULL);
  5331.         return TCL_OK;
  5332.     }
  5333.         
  5334.     if ((cmdName[0] == 'q') &&
  5335.             (strncmp(cmdName, "queuedcr", len) == 0)) {
  5336.         if (argc != 3) {
  5337.             Tcl_AppendResult(interp, "channel name required",
  5338.                     (char *) NULL);
  5339.             return TCL_ERROR;
  5340.         }
  5341.         
  5342.         Tcl_AppendResult(interp,
  5343.                 (chanPtr->flags & INPUT_SAW_CR) ? "1" : "0",
  5344.                 (char *) NULL);
  5345.         return TCL_OK;
  5346.     }
  5347.     
  5348.     if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
  5349.         hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
  5350.         if (hTblPtr == (Tcl_HashTable *) NULL) {
  5351.             return TCL_OK;
  5352.         }
  5353.         for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
  5354.                  hPtr != (Tcl_HashEntry *) NULL;
  5355.                  hPtr = Tcl_NextHashEntry(&hSearch)) {
  5356.             chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
  5357.             if (chanPtr->flags & TCL_READABLE) {
  5358.                 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
  5359.             }
  5360.         }
  5361.         return TCL_OK;
  5362.     }
  5363.  
  5364.     if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
  5365.         if (argc != 3) {
  5366.             Tcl_AppendResult(interp, "channel name required",
  5367.                     (char *) NULL);
  5368.             return TCL_ERROR;
  5369.         }
  5370.         
  5371.         sprintf(buf, "%d", chanPtr->refCount);
  5372.         Tcl_AppendResult(interp, buf, (char *) NULL);
  5373.         return TCL_OK;
  5374.     }
  5375.     
  5376.     if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
  5377.         if (argc != 3) {
  5378.             Tcl_AppendResult(interp, "channel name required",
  5379.                     (char *) NULL);
  5380.             return TCL_ERROR;
  5381.         }
  5382.         Tcl_AppendResult(interp, chanPtr->typePtr->typeName, (char *) NULL);
  5383.         return TCL_OK;
  5384.     }
  5385.     
  5386.     if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
  5387.         hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
  5388.         if (hTblPtr == (Tcl_HashTable *) NULL) {
  5389.             return TCL_OK;
  5390.         }
  5391.         for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
  5392.                  hPtr != (Tcl_HashEntry *) NULL;
  5393.                  hPtr = Tcl_NextHashEntry(&hSearch)) {
  5394.             chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
  5395.             if (chanPtr->flags & TCL_WRITABLE) {
  5396.                 Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
  5397.             }
  5398.         }
  5399.         return TCL_OK;
  5400.     }
  5401.  
  5402.     Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
  5403.             "info, open, readable, or writable",
  5404.             (char *) NULL);
  5405.     return TCL_ERROR;
  5406. }
  5407.  
  5408. /*
  5409.  *----------------------------------------------------------------------
  5410.  *
  5411.  * TclTestChannelEventCmd --
  5412.  *
  5413.  *    This procedure implements the "testchannelevent" command. It is
  5414.  *    used to test the Tcl channel event mechanism. It is present in
  5415.  *    this file instead of tclTest.c because it needs access to the
  5416.  *    internal structure of the channel.
  5417.  *
  5418.  * Results:
  5419.  *    A standard Tcl result.
  5420.  *
  5421.  * Side effects:
  5422.  *    Creates, deletes and returns channel event handlers.
  5423.  *
  5424.  *----------------------------------------------------------------------
  5425.  */
  5426.  
  5427.     /* ARGSUSED */
  5428. int
  5429. TclTestChannelEventCmd(dummy, interp, argc, argv)
  5430.     ClientData dummy;            /* Not used. */
  5431.     Tcl_Interp *interp;            /* Current interpreter. */
  5432.     int argc;                /* Number of arguments. */
  5433.     char **argv;            /* Argument strings. */
  5434. {
  5435.     Channel *chanPtr;
  5436.     EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
  5437.     char *cmd;
  5438.     int index, i, mask, len;
  5439.  
  5440.     if ((argc < 3) || (argc > 5)) {
  5441.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  5442.                 " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
  5443.         return TCL_ERROR;
  5444.     }
  5445.     chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
  5446.     if (chanPtr == (Channel *) NULL) {
  5447.         return TCL_ERROR;
  5448.     }
  5449.     cmd = argv[2];
  5450.     len = strlen(cmd);
  5451.     if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
  5452.         if (argc != 5) {
  5453.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  5454.                     " channelName add eventSpec script\"", (char *) NULL);
  5455.             return TCL_ERROR;
  5456.         }
  5457.         if (strcmp(argv[3], "readable") == 0) {
  5458.             mask = TCL_READABLE;
  5459.         } else if (strcmp(argv[3], "writable") == 0) {
  5460.             mask = TCL_WRITABLE;
  5461.         } else {
  5462.             Tcl_AppendResult(interp, "bad event name \"", argv[3],
  5463.                     "\": must be readable or writable", (char *) NULL);
  5464.             return TCL_ERROR;
  5465.         }
  5466.  
  5467.         esPtr = (EventScriptRecord *) ckalloc((unsigned)
  5468.                 sizeof(EventScriptRecord));
  5469.         esPtr->nextPtr = chanPtr->scriptRecordPtr;
  5470.         chanPtr->scriptRecordPtr = esPtr;
  5471.         
  5472.         esPtr->chanPtr = chanPtr;
  5473.         esPtr->interp = interp;
  5474.         esPtr->mask = mask;
  5475.         esPtr->script = ckalloc((unsigned) (strlen(argv[4]) + 1));
  5476.         strcpy(esPtr->script, argv[4]);
  5477.  
  5478.         Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
  5479.                 ChannelEventScriptInvoker, (ClientData) esPtr);
  5480.         
  5481.         return TCL_OK;
  5482.     }
  5483.  
  5484.     if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
  5485.         if (argc != 4) {
  5486.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  5487.                     " channelName delete index\"", (char *) NULL);
  5488.             return TCL_ERROR;
  5489.         }
  5490.         if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
  5491.             return TCL_ERROR;
  5492.         }
  5493.         if (index < 0) {
  5494.             Tcl_AppendResult(interp, "bad event index: ", argv[3],
  5495.                     ": must be nonnegative", (char *) NULL);
  5496.             return TCL_ERROR;
  5497.         }
  5498.         for (i = 0, esPtr = chanPtr->scriptRecordPtr;
  5499.                  (i < index) && (esPtr != (EventScriptRecord *) NULL);
  5500.                  i++, esPtr = esPtr->nextPtr) {
  5501.         /* Empty loop body. */
  5502.         }
  5503.         if (esPtr == (EventScriptRecord *) NULL) {
  5504.             Tcl_AppendResult(interp, "bad event index ", argv[3],
  5505.                     ": out of range", (char *) NULL);
  5506.             return TCL_ERROR;
  5507.         }
  5508.         if (esPtr == chanPtr->scriptRecordPtr) {
  5509.             chanPtr->scriptRecordPtr = esPtr->nextPtr;
  5510.         } else {
  5511.             for (prevEsPtr = chanPtr->scriptRecordPtr;
  5512.                      (prevEsPtr != (EventScriptRecord *) NULL) &&
  5513.                          (prevEsPtr->nextPtr != esPtr);
  5514.                      prevEsPtr = prevEsPtr->nextPtr) {
  5515.                 /* Empty loop body. */
  5516.             }
  5517.             if (prevEsPtr == (EventScriptRecord *) NULL) {
  5518.                 panic("TclTestChannelEventCmd: damaged event script list");
  5519.             }
  5520.             prevEsPtr->nextPtr = esPtr->nextPtr;
  5521.         }
  5522.         Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
  5523.                 ChannelEventScriptInvoker, (ClientData) esPtr);
  5524.     ckfree(esPtr->script);
  5525.         ckfree((char *) esPtr);
  5526.  
  5527.         return TCL_OK;
  5528.     }
  5529.  
  5530.     if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
  5531.         if (argc != 3) {
  5532.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  5533.                     " channelName list\"", (char *) NULL);
  5534.             return TCL_ERROR;
  5535.         }
  5536.         for (esPtr = chanPtr->scriptRecordPtr;
  5537.                  esPtr != (EventScriptRecord *) NULL;
  5538.                  esPtr = esPtr->nextPtr) {
  5539.             Tcl_AppendElement(interp,
  5540.                     esPtr->mask == TCL_READABLE ? "readable" : "writable");
  5541.             Tcl_AppendElement(interp, esPtr->script);
  5542.         }
  5543.         return TCL_OK;
  5544.     }
  5545.  
  5546.     if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
  5547.         if (argc != 3) {
  5548.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  5549.                     " channelName removeall\"", (char *) NULL);
  5550.             return TCL_ERROR;
  5551.         }
  5552.         for (esPtr = chanPtr->scriptRecordPtr;
  5553.                  esPtr != (EventScriptRecord *) NULL;
  5554.                  esPtr = nextEsPtr) {
  5555.             nextEsPtr = esPtr->nextPtr;
  5556.             Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
  5557.                     ChannelEventScriptInvoker, (ClientData) esPtr);
  5558.         ckfree(esPtr->script);
  5559.             ckfree((char *) esPtr);
  5560.         }
  5561.         chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
  5562.         return TCL_OK;
  5563.     }
  5564.  
  5565.     Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
  5566.             "add, delete, list, or removeall", (char *) NULL);
  5567.     return TCL_ERROR;
  5568.  
  5569. }
  5570.  
  5571. /*
  5572.  *----------------------------------------------------------------------
  5573.  *
  5574.  * TclCopyChannel --
  5575.  *
  5576.  *    This routine copies data from one channel to another, either
  5577.  *    synchronously or asynchronously.  If a command script is
  5578.  *    supplied, the operation runs in the background.  The script
  5579.  *    is invoked when the copy completes.  Otherwise the function
  5580.  *    waits until the copy is completed before returning.
  5581.  *
  5582.  * Results:
  5583.  *    A standard Tcl result.
  5584.  *
  5585.  * Side effects:
  5586.  *    May schedule a background copy operation that causes both
  5587.  *    channels to be marked busy.
  5588.  *
  5589.  *----------------------------------------------------------------------
  5590.  */
  5591.  
  5592. int
  5593. TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
  5594.     Tcl_Interp *interp;        /* Current interpreter. */
  5595.     Tcl_Channel inChan;        /* Channel to read from. */
  5596.     Tcl_Channel outChan;    /* Channel to write to. */
  5597.     int toRead;            /* Amount of data to copy, or -1 for all. */
  5598.     Tcl_Obj *cmdPtr;        /* Pointer to script to execute or NULL. */
  5599. {
  5600.     Channel *inPtr = (Channel *) inChan;
  5601.     Channel *outPtr = (Channel *) outChan;
  5602.     int readFlags, writeFlags;
  5603.     CopyState *csPtr;
  5604.     int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
  5605.  
  5606.     if (inPtr->csPtr) {
  5607.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
  5608.         Tcl_GetChannelName(inChan), "\" is busy", NULL);
  5609.     return TCL_ERROR;
  5610.     }
  5611.     if (outPtr->csPtr) {
  5612.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
  5613.         Tcl_GetChannelName(outChan), "\" is busy", NULL);
  5614.     return TCL_ERROR;
  5615.     }
  5616.  
  5617.     readFlags = inPtr->flags;
  5618.     writeFlags = outPtr->flags;
  5619.  
  5620.     /*
  5621.      * Set up the blocking mode appropriately.  Background copies need
  5622.      * non-blocking channels.  Foreground copies need blocking channels.
  5623.      * If there is an error, restore the old blocking mode.
  5624.      */
  5625.  
  5626.     if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
  5627.     if (SetBlockMode(interp, inPtr,
  5628.         nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING)
  5629.         != TCL_OK) {
  5630.         return TCL_ERROR;
  5631.     }
  5632.     }        
  5633.     if (inPtr != outPtr) {
  5634.     if (nonBlocking != (writeFlags & CHANNEL_NONBLOCKING)) {
  5635.         if (SetBlockMode(NULL, outPtr,
  5636.             nonBlocking ? TCL_MODE_BLOCKING : TCL_MODE_NONBLOCKING)
  5637.             != TCL_OK) {
  5638.         if (nonBlocking != (readFlags & CHANNEL_NONBLOCKING)) {
  5639.             SetBlockMode(NULL, inPtr,
  5640.                 (readFlags & CHANNEL_NONBLOCKING)
  5641.                 ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
  5642.             return TCL_ERROR;
  5643.         }
  5644.         }
  5645.     }
  5646.     }
  5647.  
  5648.     /*
  5649.      * Make sure the output side is unbuffered.
  5650.      */
  5651.  
  5652.     outPtr->flags = (outPtr->flags & ~(CHANNEL_LINEBUFFERED))
  5653.     | CHANNEL_UNBUFFERED;
  5654.  
  5655.     /*
  5656.      * Allocate a new CopyState to maintain info about the current copy in
  5657.      * progress.  This structure will be deallocated when the copy is
  5658.      * completed.
  5659.      */
  5660.  
  5661.     csPtr = (CopyState*) ckalloc(sizeof(CopyState) + inPtr->bufSize);
  5662.     csPtr->bufSize = inPtr->bufSize;
  5663.     csPtr->readPtr = inPtr;
  5664.     csPtr->writePtr = outPtr;
  5665.     csPtr->readFlags = readFlags;
  5666.     csPtr->writeFlags = writeFlags;
  5667.     csPtr->toRead = toRead;
  5668.     csPtr->total = 0;
  5669.     csPtr->interp = interp;
  5670.     if (cmdPtr) {
  5671.     Tcl_IncrRefCount(cmdPtr);
  5672.     }
  5673.     csPtr->cmdPtr = cmdPtr;
  5674.     inPtr->csPtr = csPtr;
  5675.     outPtr->csPtr = csPtr;
  5676.  
  5677.     /*
  5678.      * Start copying data between the channels.
  5679.      */
  5680.  
  5681.     return CopyData(csPtr, 0);
  5682. }
  5683.  
  5684. /*
  5685.  *----------------------------------------------------------------------
  5686.  *
  5687.  * CopyData --
  5688.  *
  5689.  *    This function implements the lowest level of the copying
  5690.  *    mechanism for TclCopyChannel.
  5691.  *
  5692.  * Results:
  5693.  *    Returns TCL_OK on success, else TCL_ERROR.
  5694.  *
  5695.  * Side effects:
  5696.  *    Moves data between channels, may create channel handlers.
  5697.  *
  5698.  *----------------------------------------------------------------------
  5699.  */
  5700.  
  5701. static int
  5702. CopyData(csPtr, mask)
  5703.     CopyState *csPtr;        /* State of copy operation. */
  5704.     int mask;            /* Current channel event flags. */
  5705. {
  5706.     Tcl_Interp *interp;
  5707.     Tcl_Obj *cmdPtr, *errObj = NULL;
  5708.     Tcl_Channel inChan, outChan;
  5709.     int result = TCL_OK;
  5710.     int size;
  5711.     int total;
  5712.  
  5713.     inChan = (Tcl_Channel)csPtr->readPtr;
  5714.     outChan = (Tcl_Channel)csPtr->writePtr;
  5715.     interp = csPtr->interp;
  5716.     cmdPtr = csPtr->cmdPtr;
  5717.  
  5718.     /*
  5719.      * Copy the data the slow way, using the translation mechanism.
  5720.      */
  5721.  
  5722.     while (csPtr->toRead != 0) {
  5723.  
  5724.     /*
  5725.      * Check for unreported background errors.
  5726.      */
  5727.  
  5728.     if (csPtr->readPtr->unreportedError != 0) {
  5729.         Tcl_SetErrno(csPtr->readPtr->unreportedError);
  5730.         csPtr->readPtr->unreportedError = 0;
  5731.         goto readError;
  5732.     }
  5733.     if (csPtr->writePtr->unreportedError != 0) {
  5734.         Tcl_SetErrno(csPtr->writePtr->unreportedError);
  5735.         csPtr->writePtr->unreportedError = 0;
  5736.         goto writeError;
  5737.     }
  5738.     
  5739.     /*
  5740.      * Read up to bufSize bytes.
  5741.      */
  5742.  
  5743.     if ((csPtr->toRead == -1)
  5744.         || (csPtr->toRead > csPtr->bufSize)) {
  5745.         size = csPtr->bufSize;
  5746.     } else {
  5747.         size = csPtr->toRead;
  5748.     }
  5749.     size = DoRead(csPtr->readPtr, csPtr->buffer, size);
  5750.  
  5751.     if (size < 0) {
  5752.         readError:
  5753.         errObj = Tcl_NewObj();
  5754.         Tcl_AppendStringsToObj(errObj, "error reading \"",
  5755.             Tcl_GetChannelName(inChan), "\": ",
  5756.             Tcl_PosixError(interp), (char *) NULL);
  5757.         break;
  5758.     } else if (size == 0) {
  5759.         /*
  5760.          * We had an underflow on the read side.  If we are at EOF,
  5761.          * then the copying is done, otherwise set up a channel
  5762.          * handler to detect when the channel becomes readable again.
  5763.          */
  5764.         
  5765.         if (Tcl_Eof(inChan)) {
  5766.         break;
  5767.         } else if (!(mask & TCL_READABLE)) {
  5768.         if (mask & TCL_WRITABLE) {
  5769.             Tcl_DeleteChannelHandler(outChan, CopyEventProc,
  5770.                 (ClientData) csPtr);
  5771.         }
  5772.         Tcl_CreateChannelHandler(inChan, TCL_READABLE,
  5773.             CopyEventProc, (ClientData) csPtr);
  5774.         }
  5775.         return TCL_OK;
  5776.     }
  5777.  
  5778.     /*
  5779.      * Now write the buffer out.
  5780.      */
  5781.  
  5782.     size = DoWrite(csPtr->writePtr, csPtr->buffer, size);
  5783.     if (size < 0) {
  5784.         writeError:
  5785.         errObj = Tcl_NewObj();
  5786.         Tcl_AppendStringsToObj(errObj, "error writing \"",
  5787.             Tcl_GetChannelName(outChan), "\": ",
  5788.             Tcl_PosixError(interp), (char *) NULL);
  5789.         break;
  5790.     }
  5791.  
  5792.     /*
  5793.      * Check to see if the write is happening in the background.  If so,
  5794.      * stop copying and wait for the channel to become writable again.
  5795.      */
  5796.  
  5797.     if (csPtr->writePtr->flags & BG_FLUSH_SCHEDULED) {
  5798.         if (!(mask & TCL_WRITABLE)) {
  5799.         if (mask & TCL_READABLE) {
  5800.             Tcl_DeleteChannelHandler(outChan, CopyEventProc,
  5801.                 (ClientData) csPtr);
  5802.         }
  5803.         Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
  5804.             CopyEventProc, (ClientData) csPtr);
  5805.         }
  5806.         return TCL_OK;
  5807.     }
  5808.  
  5809.     /*
  5810.      * Update the current byte count if we care.
  5811.      */
  5812.  
  5813.     if (csPtr->toRead != -1) {
  5814.         csPtr->toRead -= size;
  5815.     }
  5816.     csPtr->total += size;
  5817.  
  5818.     /*
  5819.      * For background copies, we only do one buffer per invocation so
  5820.      * we don't starve the rest of the system.
  5821.      */
  5822.  
  5823.     if (cmdPtr) {
  5824.         /*
  5825.          * The first time we enter this code, there won't be a
  5826.          * channel handler established yet, so do it here.
  5827.          */
  5828.  
  5829.         if (mask == 0) {
  5830.         Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
  5831.             CopyEventProc, (ClientData) csPtr);
  5832.         }
  5833.         return TCL_OK;
  5834.     }
  5835.     }
  5836.  
  5837.     /*
  5838.      * Make the callback or return the number of bytes transferred.
  5839.      * The local total is used because StopCopy frees csPtr.
  5840.      */
  5841.  
  5842.     total = csPtr->total;
  5843.     if (cmdPtr) {
  5844.     /*
  5845.      * Get a private copy of the command so we can mutate it
  5846.      * by adding arguments.  Note that StopCopy frees our saved
  5847.      * reference to the original command obj.
  5848.      */
  5849.  
  5850.     cmdPtr = Tcl_DuplicateObj(cmdPtr);
  5851.     Tcl_IncrRefCount(cmdPtr);
  5852.     StopCopy(csPtr);
  5853.     Tcl_Preserve((ClientData) interp);
  5854.  
  5855.     Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
  5856.     if (errObj) {
  5857.         Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
  5858.     }
  5859.     if (Tcl_EvalObj(interp, cmdPtr) != TCL_OK) {
  5860.         Tcl_BackgroundError(interp);
  5861.         result = TCL_ERROR;
  5862.     }
  5863.     Tcl_DecrRefCount(cmdPtr);
  5864.     Tcl_Release((ClientData) interp);
  5865.     } else {
  5866.     StopCopy(csPtr);
  5867.     if (errObj) {
  5868.         Tcl_SetObjResult(interp, errObj);
  5869.         result = TCL_ERROR;
  5870.     } else {
  5871.         Tcl_ResetResult(interp);
  5872.         Tcl_SetIntObj(Tcl_GetObjResult(interp), total);
  5873.     }
  5874.     }
  5875.     return result;
  5876. }
  5877.  
  5878. /*
  5879.  *----------------------------------------------------------------------
  5880.  *
  5881.  * CopyEventProc --
  5882.  *
  5883.  *    This routine is invoked as a channel event handler for
  5884.  *    the background copy operation.  It is just a trivial wrapper
  5885.  *    around the CopyData routine.
  5886.  *
  5887.  * Results:
  5888.  *    None.
  5889.  *
  5890.  * Side effects:
  5891.  *    None.
  5892.  *
  5893.  *----------------------------------------------------------------------
  5894.  */
  5895.  
  5896. static void
  5897. CopyEventProc(clientData, mask)
  5898.     ClientData clientData;
  5899.     int mask;
  5900. {
  5901.     (void) CopyData((CopyState *)clientData, mask);
  5902. }
  5903.  
  5904. /*
  5905.  *----------------------------------------------------------------------
  5906.  *
  5907.  * StopCopy --
  5908.  *
  5909.  *    This routine halts a copy that is in progress.
  5910.  *
  5911.  * Results:
  5912.  *    None.
  5913.  *
  5914.  * Side effects:
  5915.  *    Removes any pending channel handlers and restores the blocking
  5916.  *    and buffering modes of the channels.  The CopyState is freed.
  5917.  *
  5918.  *----------------------------------------------------------------------
  5919.  */
  5920.  
  5921. static void
  5922. StopCopy(csPtr)
  5923.     CopyState *csPtr;        /* State for bg copy to stop . */
  5924. {
  5925.     int nonBlocking;
  5926.  
  5927.     if (!csPtr) {
  5928.     return;
  5929.     }
  5930.  
  5931.     /*
  5932.      * Restore the old blocking mode and output buffering mode.
  5933.      */
  5934.  
  5935.     nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);
  5936.     if (nonBlocking != (csPtr->readPtr->flags & CHANNEL_NONBLOCKING)) {
  5937.     SetBlockMode(NULL, csPtr->readPtr,
  5938.         nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
  5939.     }
  5940.     if (csPtr->writePtr != csPtr->writePtr) {
  5941.     if (nonBlocking != (csPtr->writePtr->flags & CHANNEL_NONBLOCKING)) {
  5942.         SetBlockMode(NULL, csPtr->writePtr,
  5943.             nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
  5944.     }
  5945.     }
  5946.     csPtr->writePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
  5947.     csPtr->writePtr->flags |=
  5948.     csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
  5949.         
  5950.  
  5951.     if (csPtr->cmdPtr) {
  5952.     Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,
  5953.         (ClientData)csPtr);
  5954.     if (csPtr->readPtr != csPtr->writePtr) {
  5955.         Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,
  5956.             CopyEventProc, (ClientData)csPtr);
  5957.     }
  5958.         Tcl_DecrRefCount(csPtr->cmdPtr);
  5959.     }
  5960.     csPtr->readPtr->csPtr = NULL;
  5961.     csPtr->writePtr->csPtr = NULL;
  5962.     ckfree((char*) csPtr);
  5963. }
  5964.